- Added the lux;seed slot to the compiler state.

- Macro declarations are now handled at the compiler-phase instead of the analyser phase to avoid the posibility of trying to declare a yet-uncompiled macro (due to the macro-expansion of defmacro).
- Added a makeshift implementation of existential types on top of BoundT (must migrate to a more permanent implementation).

6 files changed, 109 insertions, 40 deletions

diff --git a/source/lux.lux b/source/lux.lux
index 8e004913b..a385bb700 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -238,7 +238,8 @@
                                                     (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) Void])])]
                                                             (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
                                                                     (#Cons [["lux;host" HostState]
-                                                                            #Nil])])])])])]))])
+                                                                            (#Cons [["lux;seed" Int]
+                                                                                    #Nil])])])])])])]))])
           Void]))
 (export' CompilerState)
 
@@ -1284,7 +1285,8 @@
 ##   (let [[module name] ident]
 ##     (case' state
 ##            {#source source #modules modules #module-aliases module-aliases
-##             #envs   envs   #types   types   #host           host}
+##             #envs   envs   #types   types   #host           host
+##             #seed   seed}
 ##            (case' (:' ($' Maybe Macro)
 ##                       (do Maybe:Monad
 ##                         [bindings (get module modules)
@@ -1306,7 +1308,8 @@
   (let [[module name] ident]
     (case' state
            {#source source #modules modules #module-aliases module-aliases
-            #envs   envs   #types   types   #host           host}
+            #envs   envs   #types   types   #host           host
+            #seed   seed}
            (case' (:' ($' Maybe Macro)
                       (case' (get module modules)
                              (#Some bindings)
@@ -1335,6 +1338,32 @@
     (-> ($' List ($' List a)) ($' List a)))
   (fold list:++ #Nil xs))
 
+## (def #export (macro-expand syntax state)
+##   (-> Syntax ($' Lux ($' List Syntax)))
+##   (case' syntax
+##          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
+##          (do Lux:Monad
+##            [macro' (find-macro macro-name)]
+##            (case' macro'
+##                   (#Some macro)
+##                   (do Lux:Monad
+##                     [expansion (macro args)
+##                      expansion' (map% Lux:Monad macro-expand expansion)]
+##                     (return (:' SyntaxList (join-list expansion'))))
+                  
+##                   #None
+##                   (do Lux:Monad
+##                     [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
+##                     (return (:' Syntax (list ($form (join-list parts'))))))))
+
+##          (#Meta [_ (#Tuple members)])
+##          (do Lux:Monad
+##            [members' (map% Lux:Monad macro-expand members)]
+##            (return (:' Syntax (list ($tuple (join-list members'))))))
+
+##          _
+##          (return (:' SyntaxList (list syntax)))))
+
 (def #export (macro-expand syntax state)
   (-> Syntax ($' Lux ($' List Syntax)))
   (case' syntax
@@ -1346,17 +1375,17 @@
                   (do Lux:Monad
                     [expansion (macro args)
                      expansion' (map% Lux:Monad macro-expand expansion)]
-                    (return (:' SyntaxList (join-list expansion'))))
+                    (;return (:' SyntaxList (join-list expansion'))))
                   
                   #None
                   (do Lux:Monad
                     [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
-                    (return (:' Syntax (list ($form (join-list parts'))))))))
+                    (;return (:' Syntax (list ($form (join-list parts'))))))))
 
          (#Meta [_ (#Tuple members)])
          (do Lux:Monad
            [members' (map% Lux:Monad macro-expand members)]
-           (return (:' Syntax (list ($tuple (join-list members'))))))
+           (;return (:' Syntax (list ($tuple (join-list members'))))))
 
          _
          (return (:' SyntaxList (list syntax)))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 7c9b9b5f0..191a16235 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -320,7 +320,17 @@
             (|do [? (&type/bound? ?id)]
               (if ?
                 (|do [dtype (&type/deref ?id)]
-                  (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))
+                  (matchv ::M/objects [dtype]
+                    [["lux;BoundT" _]]
+                    (matchv ::M/objects [output]
+                      [["Expression" [_expr _]]]
+                      ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))]
+                      ;;   (return (&/V "Expression" (&/T _expr exo-type))))
+                      (return (&/V "Expression" (&/T _expr exo-type)))
+                      )
+
+                    [_]
+                    (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))))
                 (matchv ::M/objects [output]
                   [["Expression" [_expr _]]]
                   ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))]
@@ -388,6 +398,10 @@
         _ (&&module/declare-macro module-name ?name)]
     (return (&/|list))))
 
+(defn analyse-declare-macro [analyse ?name]
+  (|do [module-name &/get-module-name]
+    (return (&/|list (&/V "Statement" (&/V "declare-macro" (&/T module-name ?name)))))))
+
 (defn analyse-import [analyse exo-type ?path]
   (return (&/|list)))
 
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 4f3e6f028..306c09b19 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -24,8 +24,9 @@
 (def $HOST 1)
 (def $MODULE-ALIASES 2)
 (def $MODULES 3)
-(def $SOURCE 4)
-(def $TYPES 5)
+(def $SEED 4)
+(def $SOURCE 5)
+(def $TYPES 6)
 
 ;; [Exports]
 (def +name-separator+ ";")
@@ -555,6 +556,8 @@
    (|table)
    ;; "lux;modules"
    (|table)
+   ;; "lux;seed"
+   0
    ;; "lux;source"
    (V "lux;None" nil)
    ;; "lux;types"
@@ -593,6 +596,11 @@
       (catch Throwable _
         (fail* "No local environment.")))))
 
+(def gen-id
+  (fn [state]
+    (let [seed (get$ $SEED state)]
+      (return* (set$ $SEED (inc seed) state) seed))))
+
 (defn ->seq [xs]
   (matchv ::M/objects [xs]
     [["lux;Nil" _]]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 6a9cc58c6..e6879f4da 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -317,6 +317,9 @@
         (matchv ::M/objects [?form]
           [["def" [?name ?body ?def-data]]]
           (&&lux/compile-def compile-expression ?name ?body ?def-data)
+
+          [["declare-macro" [?module ?name]]]
+          (&&lux/compile-declare-macro compile-expression ?module ?name)
           
           [["jvm-interface" [?package ?name ?methods]]]
           (&&host/compile-jvm-interface compile-expression ?package ?name ?methods)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 1553d3975..35a706f05 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -165,3 +165,7 @@
         ;; :let [_ (prn 'compile-def/_2 ?name)]
         ]
     (return nil)))
+
+(defn compile-declare-macro [compile module name]
+  (|do [_ (&a-module/declare-macro module name)]
+    (return nil)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 217a167a4..b739be3c2 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -150,7 +150,8 @@
                                                                                 (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text))
                                                                                                      $Void)))))
                                            (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type)))
-                                           (&/T "lux;host" HostState))))
+                                           (&/T "lux;host" HostState)
+                                           (&/T "lux;seed" Int))))
                        $Void)))
 
 (def Macro
@@ -212,37 +213,42 @@
 
 (declare clean*)
 (defn ^:private delete-var [id]
-  (fn [state]
-    (&/run-state (|do [mappings* (&/map% (fn [binding]
-                                           (|let [[?id ?type] binding]
-                                             (if (= id ?id)
-                                               (return binding)
-                                               (matchv ::M/objects [?type]
-                                                 [["lux;None" _]]
+  (|do [? (bound? id)
+        _ (if ?
+            (return nil)
+            (|do [seed &/gen-id]
+              (set-var id (&/V "lux;BoundT" (str seed)))))]
+    (fn [state]
+      (&/run-state (|do [mappings* (&/map% (fn [binding]
+                                             (|let [[?id ?type] binding]
+                                               (if (= id ?id)
                                                  (return binding)
-
-                                                 [["lux;Some" ?type*]]
-                                                 (matchv ::M/objects [?type*]
-                                                   [["lux;VarT" ?id*]]
-                                                   (if (= id ?id*)
-                                                     (return (&/T ?id (&/V "lux;None" nil)))
-                                                     (return binding)
-                                                     ;; (|do [?type** (clean* id ?type*)]
-                                                     ;;   (return (&/T ?id (&/V "lux;Some" ?type**))))
-                                                     )
-
-                                                   [_]
-                                                   (|do [?type** (clean* id ?type*)]
-                                                     (return (&/T ?id (&/V "lux;Some" ?type**)))))
-                                                 ))))
-                                         (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
-                   (fn [state]
-                     (return* (&/update$ &/$TYPES #(->> %
-                                                        (&/update$ &/$COUNTER dec)
-                                                        (&/set$ &/$MAPPINGS (&/|remove id mappings*)))
-                                         state)
-                              nil)))
-                 state)))
+                                                 (matchv ::M/objects [?type]
+                                                   [["lux;None" _]]
+                                                   (return binding)
+
+                                                   [["lux;Some" ?type*]]
+                                                   (matchv ::M/objects [?type*]
+                                                     [["lux;VarT" ?id*]]
+                                                     (if (= id ?id*)
+                                                       (return (&/T ?id (&/V "lux;None" nil)))
+                                                       (return binding)
+                                                       ;; (|do [?type** (clean* id ?type*)]
+                                                       ;;   (return (&/T ?id (&/V "lux;Some" ?type**))))
+                                                       )
+
+                                                     [_]
+                                                     (|do [?type** (clean* id ?type*)]
+                                                       (return (&/T ?id (&/V "lux;Some" ?type**)))))
+                                                   ))))
+                                           (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
+                     (fn [state]
+                       (return* (&/update$ &/$TYPES #(->> %
+                                                          (&/update$ &/$COUNTER dec)
+                                                          (&/set$ &/$MAPPINGS (&/|remove id mappings*)))
+                                           state)
+                                nil)))
+                   state))))
 
 (defn with-var [k]
   (|do [id create-var
@@ -749,6 +755,11 @@
         (return (&/T fixpoints* nil)))
       (fail "[Type Error] Records don't match in size."))
 
+    [["lux;BoundT" e!name] ["lux;BoundT" a!name]]
+    (if (= e!name a!name)
+      (return (&/T fixpoints nil))
+      (check-error expected actual))
+
     [_ _]
     (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual)))
     ))