- Implemented some new macros & functions in lux.lux.

- WORKING ON DEBUGGING A COMPILER ERROR: java.lang.IncompatibleClassChangeError

4 files changed, 251 insertions, 149 deletions

diff --git a/source/lux.lux b/source/lux.lux
index 94f4853d8..04ffcf91f 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -949,7 +949,7 @@
   (case' tokens
          (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil])
          (return (:' SyntaxList
-                     (list (` (#DataT (~ (_meta (#Text class-name))))))))
+                     (list (` (#;DataT (~ (_meta (#Text class-name))))))))
 
          _
          (fail "Wrong syntax for ^")))
@@ -969,7 +969,7 @@
 
 (defmacro #export (, tokens)
   (return (:' SyntaxList
-              (list (` (#TupleT (list (~@ tokens))))))))
+              (list (` (#;TupleT (;list (~@ tokens))))))))
 
 (defmacro (do tokens)
   (case' tokens
@@ -977,10 +977,15 @@
          (let [body' (fold (:' (-> Syntax (, Syntax Syntax) Syntax)
                                (lambda [body' binding]
                                  (let [[var value] binding]
-                                   (` (;bind (lambda' (~ ($symbol ["" ""]))
-                                                 (~ var)
-                                                 (~ body'))
-                                             (~ value))))))
+                                   (case' var
+                                          (#Meta [_ (#Tag ["" "let"])])
+                                          (` (;let (~ value) (~ body')))
+
+                                          _
+                                          (` (;bind (lambda' (~ ($symbol ["" ""]))
+                                                        (~ var)
+                                                        (~ body'))
+                                                    (~ value)))))))
                            body
                            (reverse (as-pairs bindings)))]
            (return (:' SyntaxList
@@ -1180,7 +1185,7 @@
                      (lambda [token]
                        (case' token
                               (#Meta [_ (#Tag ident)])
-                              (;return (:' Syntax (` [(~ ($text (ident->text ident))) (,)])))
+                              (;return (:' Syntax (` [(~ ($text (ident->text ident))) (;,)])))
 
                               (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))])
                               (;return (:' Syntax (` [(~ ($text (ident->text ident))) (~ value)])))
@@ -1188,7 +1193,7 @@
                               _
                               (fail "Wrong syntax for |"))))
                  tokens)]
-    (;return (:' SyntaxList (list (` (#VariantT (list (~@ pairs)))))))))
+    (;return (:' SyntaxList (list (` (#;VariantT (;list (~@ pairs)))))))))
 
 (defmacro #export (& tokens)
   (if (not (multiple? 2 (length tokens)))
@@ -1204,7 +1209,7 @@
                                 _
                                 (fail "Wrong syntax for &"))))
                    (as-pairs tokens))]
-      (;return (:' SyntaxList (list (` (#RecordT (list (~@ pairs))))))))))
+      (;return (:' SyntaxList (list (` (#;RecordT (;list (~@ pairs))))))))))
 
 (def (replace-syntax reps syntax)
   (-> RepEnv Syntax Syntax)
@@ -1252,15 +1257,15 @@
                          
                          (#Cons [harg targs])
                          (let [replacements (map (:' (-> Text (, Text Syntax))
-                                                     (lambda [ident] [ident (` (#BoundT (~ ($text ident))))]))
+                                                     (lambda [ident] [ident (` (#;BoundT (~ ($text ident))))]))
                                                  (list& self-ident idents))
                                body' (fold (:' (-> Syntax Text Syntax)
                                                (lambda [body' arg']
-                                                 (` (#AllT [#None "" (~ ($text arg')) (~ body')]))))
+                                                 (` (#;AllT [#;None "" (~ ($text arg')) (~ body')]))))
                                            (replace-syntax replacements body)
                                            (reverse targs))]
                            (return (:' SyntaxList
-                                       (list (` (#AllT [#None (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))))
+                                       (list (` (#;AllT [#;None (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))))
                   
                   #None
                   (fail "'All' arguments must be symbols."))
@@ -1303,12 +1308,64 @@
     (-> ($' List ($' List a)) ($' List a)))
   (fold list:++ #Nil xs))
 
+(def #export (normalize ident state)
+  (-> Ident ($' Lux Ident))
+  (case' ident
+         ["" name]
+         (case' state
+                {#source source #modules modules #module-aliases module-aliases
+                 #envs   envs   #types   types   #host           host
+                 #seed   seed}
+                (case' (reverse envs)
+                       #Nil
+                       (#Left "Can't normalize Ident without a global environment.")
+
+                       (#Cons [{#name prefix #inner-closures _ #locals _ #closure _} _])
+                       (#Right [state [prefix name]])))
+         
+         _
+         (#Right [state ident])))
+
+## (def #export (macro-expand syntax)
+##   (-> Syntax ($' Lux ($' List Syntax)))
+##   (case' syntax
+##          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
+##          (do Lux:Monad
+##            [macro-name' (normalize macro-name)
+##             ?macro (find-macro macro-name')]
+##            (case' (:' ($' Maybe Macro) ?macro)
+##                   (#Some macro)
+##                   (do Lux:Monad
+##                     [expansion (macro args)
+##                      expansion' (map% Lux:Monad macro-expand expansion)]
+##                     (;return (:' SyntaxList (list:join expansion'))))
+                  
+##                   #None
+##                   (do Lux:Monad
+##                     [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
+##                     (;return (:' SyntaxList (list ($form (list:join parts'))))))))
+
+##          ## (#Meta [_ (#Form (#Cons [harg targs]))])
+##          ## (do Lux:Monad
+##          ##   [harg+ (macro-expand harg)
+##          ##    targs+ (map% Lux:Monad macro-expand targs)]
+##          ##   (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))
+
+##          (#Meta [_ (#Tuple members)])
+##          (do Lux:Monad
+##            [members' (map% Lux:Monad macro-expand members)]
+##            (;return (:' SyntaxList (list ($tuple (list:join members'))))))
+
+##          _
+##          (return (:' SyntaxList (list syntax)))))
+
 (def #export (macro-expand syntax)
   (-> Syntax ($' Lux ($' List Syntax)))
   (case' syntax
          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
          (do Lux:Monad
-           [?macro (find-macro macro-name)]
+           [macro-name' (normalize macro-name)
+            ?macro (find-macro macro-name')]
            (case' (:' ($' Maybe Macro) ?macro)
                   (#Some macro)
                   (do Lux:Monad
@@ -1321,6 +1378,12 @@
                     [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
                     (;return (:' SyntaxList (list ($form (list:join parts'))))))))
 
+         ## (#Meta [_ (#Form (#Cons [harg targs]))])
+         ## (do Lux:Monad
+         ##   [harg+ (macro-expand harg)
+         ##    targs+ (map% Lux:Monad macro-expand targs)]
+         ##   (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))
+
          (#Meta [_ (#Tuple members)])
          (do Lux:Monad
            [members' (map% Lux:Monad macro-expand members)]
@@ -1329,84 +1392,150 @@
          _
          (return (:' SyntaxList (list syntax)))))
 
-## ## (def (walk-type type)
-## ##   (-> Syntax ($' Lux Syntax))
-## ##   (case' type
-## ##          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol sym)]) args]))])
-## ##          (do' [macro' (find-macro sym)]
-## ##               (case' macro'
-## ##                      (#Some macro)
-## ##                      (do' [expansion (macro args)]
-## ##                           (case' expansion
-## ##                                  (#Cons [expansion' #Nil])
-## ##                                  (walk-type expansion')
-
-## ##                                  _
-## ##                                  (fail "Macro can't expand to more than 1 output.")))
-
-## ##                      #None
-## ##                      (do' [args' (map% walk-type args)]
-## ##                           (return (fold (:' (-> Syntax Syntax Syntax)
-## ##                                              (lambda [f a]
-## ##                                                (` (#AppT [(~ f) (~ a)]))))
-## ##                                          sym
-## ##                                          args')))))
-
-## ##          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) args]))])
-## ##          ...
-
-## ##          (#Meta [_ (#Symbol _)])
-## ##          (return type)
-
-## ##          _
-## ##          (fail "Wrong syntax for walk-type")))
-
-## ## (defmacro (->type tokens)
-## ##   (case' tokens
-## ##          (#Cons [type #Nil])
-## ##          (do' [type' (walk-type type)]
-## ##               (return (list type')))
+(def (walk-type type)
+  (-> Syntax Syntax)
+  (case' type
+         (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))])
+         ($form (#Cons [($tag tag) (map walk-type parts)]))
 
-## ##          _
-## ##          (fail "Wrong syntax for ->type")))
+         (#Meta [_ (#Tuple members)])
+         ($tuple (map walk-type members))
+
+         (#Meta [_ (#Form (#Cons [type-fn args]))])
+         (fold (:' (-> Syntax Syntax Syntax)
+                   (lambda [type-fn arg]
+                     (` (#;AppT [(~ type-fn) (~ arg)]))))
+               (walk-type type-fn)
+               (map walk-type args))
+         
+         _
+         type))
 
-## ## (defmacro (: tokens)
-## ##   (case' tokens
-## ##          (#Cons [type (#Cons [value #Nil])])
-## ##          (return (list (` (:' (->type (~ type)) (~ value)))))
+(defmacro #export (type` tokens)
+  (case' tokens
+         (#Cons [type #Nil])
+         (do Lux:Monad
+           [type+ (macro-expand type)]
+           (case' (:' SyntaxList type+)
+                  (#Cons [type' #Nil])
+                  (;return (:' SyntaxList (list (walk-type type'))))
+                  
+                  _
+                  (fail "type`: The expansion of the type-syntax had to yield a single element.")))
 
-## ##          _
-## ##          (fail "Wrong syntax for :")))
+         _
+         (fail "Wrong syntax for type`")))
 
-## ## (defmacro (:! tokens)
-## ##   (case' tokens
-## ##          (#Cons [type (#Cons [value #Nil])])
-## ##          (return (list (` (:!' (->type (~ type)) (~ value)))))
+(defmacro #export (: tokens)
+  (case' tokens
+         (#Cons [type (#Cons [value #Nil])])
+         (return (:' SyntaxList (list (` (:' (;type` (~ type)) (~ value))))))
 
-## ##          _
-## ##          (fail "Wrong syntax for :!")))
+         _
+         (fail "Wrong syntax for :")))
 
-## ## (deftype (IO a)
-## ##   (-> (,) a))
+(defmacro #export (:! tokens)
+  (case' tokens
+         (#Cons [type (#Cons [value #Nil])])
+         (return (:' SyntaxList (list (` (:!' (;type` (~ type)) (~ value))))))
 
-## ## (defmacro (io tokens)
-## ##   (case' tokens
-## ##          (#Cons [value #Nil])
-## ##          (return (list (` (lambda [_] (~ value)))))))
-
-## (defmacro #export (exec tokens)
-##   (case' (reverse tokens)
-##          (#Cons [value actions])
-##          (let [dummy ($symbol ["" ""])]
-##            (return (:' SyntaxList
-##                        (list (fold (:' (-> Syntax Syntax Syntax)
-##                                        (lambda [post pre]
-##                                          (` (case' (~ pre) (~ dummy) (~ post)))))
-##                                    value
-##                                    actions)))))
+         _
+         (fail "Wrong syntax for :!")))
+
+(defmacro #export (deftype tokens)
+  (let [[export? tokens'] (: (, Bool (List Syntax))
+                             (case' tokens
+                                    (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
+                                    [true tokens']
+
+                                    _
+                                    [false tokens]))
+        ## parts (: (Maybe (, Syntax (List Syntax) Syntax))
+        ##          (case' tokens'
+        ##                 (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
+        ##                 (#Some [($symbol name) #Nil type])
+
+        ##                 (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
+        ##                 (#Some [($symbol name) args type])
+
+        ##                 _
+        ##                 #None))
+        ]
+    (return (: (List Syntax) #Nil))
+    ## (case' parts
+    ##        (#Some [name args type])
+    ##        (let [with-export (: (List Syntax)
+    ##                             (if export?
+    ##                               (list (` (export' (~ name))))
+    ##                               #Nil))
+    ##              type' (: Syntax
+    ##                       (case' args
+    ##                              #Nil
+    ##                              type
+
+    ##                              _
+    ##                              (` (;All (~ name) [(~@ args)] (~ type)))))]
+    ##          (return (: (List Syntax)
+    ##                     (list& type' with-export))))
+
+    ##        #None
+    ##        (fail "Wrong syntax for deftype"))
+    ))
 
-##          _
-##          (fail "Wrong syntax for exec")))
+(deftype #export (IO a)
+  (-> (,) a))
+
+(defmacro #export (io tokens)
+  (case' tokens
+         (#Cons [value #Nil])
+         (let [blank ($symbol ["" ""])]
+           (return (list (` (lambda' (~ blank) (~ blank) (~ value))))))
+
+         _
+         (fail "Wrong syntax for io")))
+
+(defmacro #export (exec tokens)
+  (case' (reverse tokens)
+         (#Cons [value actions])
+         (let [dummy ($symbol ["" ""])]
+           (return (:' SyntaxList
+                       (list (fold (:' (-> Syntax Syntax Syntax)
+                                       (lambda [post pre]
+                                         (` (case' (~ pre) (~ dummy) (~ post)))))
+                                   value
+                                   actions)))))
+
+         _
+         (fail "Wrong syntax for exec")))
+
+(def (rejoin-pair pair)
+  (-> (, Syntax Syntax) (List Syntax))
+  (let [[left right] pair]
+    (list left right)))
+
+(defmacro #export (case tokens)
+  (case' tokens
+         (#Cons value branches)
+         (do Lux:Monad
+           [expansions (map% Lux:Monad
+                             (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
+                                (lambda expander [branch]
+                                   (let [[pattern body] branch]
+                                     (case' pattern
+                                            (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args])
+                                            (do Lux:Monad
+                                              [expansion (macro-expand (list& ($symbol macro-name) body macro-args))]
+                                              (map% Lux:Monad expander (as-pairs expansion)))
+
+                                            _
+                                            (;return (: (List (, Syntax Syntax)) (list branch)))))))
+                             (as-pairs branches))]
+           (;return (: (List (, Syntax Syntax))
+                       (list (` (case' (~ value)
+                                       (~@ (|> expansions list:join (map rejoin-pair) list:join))))))))
+
+         _
+         (fail "Wrong syntax for case")))
 
 ## (def #export (print x)
 ##   (-> Text (IO (,)))
@@ -1486,33 +1615,3 @@
 
 ## ##              [first  f]
 ## ##              [second s])
-
-## ## (defmacro (case tokens)
-## ##   (case' tokens
-## ##          (#Cons value branches)
-## ##          (loop [kind #Pattern
-## ##                 pieces branches
-## ##                 new-pieces (list)]
-## ##            (case' pieces
-## ##                   #Nil
-## ##                   (return (list (' (case' (~ value) (~@ new-pieces)))))
-
-## ##                   (#Cons piece pieces')
-## ##                   (let [[kind' expanded more-pieces] (case' kind
-## ##                                                             #Body
-## ##                                                             [#Pattern (list piece) #Nil]
-
-## ##                                                             #Pattern
-## ##                                                             (do [expansion (macro-expand piece)]
-## ##                                                               (case' expansion
-## ##                                                                      #Nil
-## ##                                                                      [#Pattern #Nil #Nil]
-
-## ##                                                                      (#Cons exp #Nil)
-## ##                                                                      [#Body (list exp) #Nil]
-
-## ##                                                                      (#Cons exp exps)
-## ##                                                                      [#Body (list exp) exps]))
-## ##                                                             )]
-## ##                     (recur kind' (++ expanded new-pieces) (++ more-pieces pieces))))
-## ##            )))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index c964058b2..59f3fbb1f 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -266,7 +266,9 @@
                 (matchv ::M/objects [_macro]
                   [["lux;Some" macro]]
                   (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))]
-                    (&/flat-map% (partial analyse exo-type) macro-expansion))
+                    (do (when (= "type`" ?name)
+                          (prn 'macro-expansion (str ?module ";" ?name) (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))
+                      (&/flat-map% (partial analyse exo-type) macro-expansion)))
 
                   [["lux;None" _]]
                   (fail (str "[Analyser Error] Macro has yet to be compiled: " (str ?module ";" ?name))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 306c09b19..4b8045e8c 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -645,8 +645,7 @@
   (|do [closure-name (|do [top get-top-local-env]
                        (return (->> top (get$ $INNER-CLOSURES) str)))]
     (fn [state]
-      (let [body* (with-scope closure-name
-                    body)]
+      (let [body* (with-scope closure-name body)]
         (run-state body* (update$ $ENVS #(|cons (update$ $INNER-CLOSURES inc (|head %))
                                                 (|tail %))
                                   state))))))
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index cfea13a73..276329a75 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -63,19 +63,19 @@
   (&/with-writer (doto (.visitMethod class Opcodes/ACC_PUBLIC "impl" impl-signature nil nil)
                    (.visitCode))
     (|do [*writer* &/get-writer
-           :let [num-locals (&&/total-locals impl-body)
-                 $start (new Label)
-                 $end (new Label)
-                 _ (doto *writer*
-                     (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "lux;DataT" "java.lang.Object")) nil $start $end (+ 2 idx))
-                         (->> (dotimes [idx num-locals])))
-                     (.visitLabel $start))]
-           ret (compile impl-body)
-           :let [_ (doto *writer*
-                     (.visitLabel $end)
-                     (.visitInsn Opcodes/ARETURN)
-                     (.visitMaxs 0 0)
-                     (.visitEnd))]]
+          :let [num-locals (&&/total-locals impl-body)
+                $start (new Label)
+                $end (new Label)
+                _ (doto *writer*
+                    (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "lux;DataT" "java.lang.Object")) nil $start $end (+ 2 idx))
+                        (->> (dotimes [idx num-locals])))
+                    (.visitLabel $start))]
+          ret (compile impl-body)
+          :let [_ (doto *writer*
+                    (.visitLabel $end)
+                    (.visitInsn Opcodes/ARETURN)
+                    (.visitMaxs 0 0)
+                    (.visitEnd))]]
       (return ret))))
 
 (defn ^:private instance-closure [compile lambda-class closed-over init-signature]
@@ -121,7 +121,7 @@
 
                                ;;            :else
                                ;;            '???))
-                             (compile ?source))))))
+                               (compile ?source))))))
         :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
     (return nil)))
 
@@ -129,23 +129,25 @@
 (defn compile-lambda [compile ?scope ?env ?body]
   ;; (prn 'compile-lambda ?scope (&host/location ?scope) ?env)
   (|do [:let [lambda-class (&host/location ?scope)
-               =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
-                        (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
-                                lambda-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
-                        (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
-                              (.visitEnd))
-                            (->> (let [captured-name (str &&/closure-prefix ?captured-id)])
-                                 (matchv ::M/objects [?name+?captured]
-                                   [[?name [["captured" [_ ?captured-id ?source]] _]]])
-                                 (doseq [?name+?captured (&/->seq ?env)
-                                         ;; :let [_ (prn '?name+?captured (alength ?name+?captured))
-                                         ;;       _ (prn '?name+?captured (aget ?name+?captured 1 0))
-                                         ;;       _ (prn '?name+?captured (aget ?name+?captured 1 1 0 0))]
-                                         ])))
-                        (add-lambda-apply lambda-class ?env)
-                        (add-lambda-<init> lambda-class ?env)
-                        )]
-         _ (add-lambda-impl =class compile lambda-impl-signature ?body)
-         :let [_ (.visitEnd =class)]
-         _ (&&/save-class! lambda-class (.toByteArray =class))]
+              =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+                       (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
+                               lambda-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
+                       (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
+                             (.visitEnd))
+                           (->> (let [captured-name (str &&/closure-prefix ?captured-id)])
+                                (matchv ::M/objects [?name+?captured]
+                                  [[?name [["captured" [_ ?captured-id ?source]] _]]])
+                                (doseq [?name+?captured (&/->seq ?env)
+                                        ;; :let [_ (prn '?name+?captured (alength ?name+?captured))
+                                        ;;       _ (prn '?name+?captured (aget ?name+?captured 1 0))
+                                        ;;       _ (prn '?name+?captured (aget ?name+?captured 1 1 0 0))]
+                                        ])))
+                       (add-lambda-apply lambda-class ?env)
+                       (add-lambda-<init> lambda-class ?env)
+                       )]
+        _ (add-lambda-impl =class compile lambda-impl-signature ?body)
+        :let [_ (.visitEnd =class)
+              ;; _ (prn 'SAVING_LAMBDA lambda-class)
+              ]
+        _ (&&/save-class! lambda-class (.toByteArray =class))]
     (instance-closure compile lambda-class ?env (lambda-<init>-signature ?env))))