Introduced the "#Macro" type and got rid of the "#lux.macro?" annotation type and its "magical" compiler behavior.

5 files changed, 47 insertions, 31 deletions

diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index dc08ac765..2a4240aa6 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -18,8 +18,9 @@
 ;; [Utils]
 ;; TODO: Walk the type to set up the parameter-type, instead of doing a
 ;; rough calculation like this one.
-(defn ^:private count-univq [type]
+(defn ^:private count-univq
   "(-> Type Int)"
+  [type]
   (|case type
     (&/$UnivQ env type*)
     (inc (count-univq type*))
@@ -29,12 +30,14 @@
 
 ;; TODO: This technique will not work if the body of the type contains
 ;; nested quantifications that cannot be directly counted.
-(defn ^:private next-parameter-type [type]
+(defn ^:private next-parameter-type
   "(-> Type Type)"
+  [type]
   (&/$Parameter (->> (count-univq type) (* 2) (+ 1))))
 
-(defn ^:private embed-inferred-input [input output]
+(defn ^:private embed-inferred-input
   "(-> Type Type Type)"
+  [input output]
   (|case output
     (&/$UnivQ env output*)
     (&/$UnivQ env (embed-inferred-input input output*))
@@ -379,8 +382,7 @@
   (|case =fn
     [_ (&&/$def ?module ?name)]
     (|do [[real-name [?type ?meta ?value]] (&&module/find-def! ?module ?name)]
-      (|case (&&meta/meta-get &&meta/macro?-tag ?meta)
-        (&/$Some _)
+      (if (&type/type= &type/Macro ?type)
         (|do [macro-expansion (fn [state]
                                 (|case (macro-caller ?value ?args state)
                                   (&/$Right state* output)
@@ -390,15 +392,13 @@
                                   ((&/fail-with-loc error) state)))
               ;; module-name &/get-module-name
               ;; :let [[r-prefix r-name] real-name
-              ;;       _ (when (= "syntax:" r-name)
+              ;;       _ (when (= "macro:'" r-name)
               ;;           (->> (&/|map &/show-ast macro-expansion)
               ;;                (&/|interpose "\n")
               ;;                (&/fold str "")
               ;;                (println 'macro-expansion (&/ident->text real-name) "@" module-name)))]
               ]
           (&/flat-map% (partial analyse exo-type) macro-expansion))
-
-        _
         (do-analyse-apply analyse exo-type =fn ?args)))
     
     _
@@ -554,7 +554,6 @@
         =meta (&&/analyse-1 analyse &type/Code ?meta)
         ==meta (eval! (optimize =meta))
         _ (&&module/test-type module-name ?name ==meta (&&/expr-type* =value))
-        _ (&&module/test-macro module-name ?name ==meta (&&/expr-type* =value))
         _ (compile-def ?name (optimize =value) ==meta)
         _ &type/reset-mappings]
     (return &/$Nil)))
@@ -685,8 +684,9 @@
                    =asyncs)]
     (return &/$Nil)))
 
-(defn ^:private coerce [new-type analysis]
+(defn ^:private coerce
   "(-> Type Analysis Analysis)"
+  [new-type analysis]
   (|let [[[_type _cursor] _analysis] analysis]
     (&&/|meta new-type _cursor
               _analysis)))
diff --git a/luxc/src/lux/analyser/meta.clj b/luxc/src/lux/analyser/meta.clj
index 1770372a9..d7a68ecb4 100644
--- a/luxc/src/lux/analyser/meta.clj
+++ b/luxc/src/lux/analyser/meta.clj
@@ -14,8 +14,9 @@
 (def ^:private tag-prefix "lux")
 
 ;; [Values]
-(defn meta-get [ident annotations]
+(defn meta-get
   "(-> Ident Code (Maybe Code))"
+  [ident annotations]
   (|case annotations
     [_ (&/$Record dict)]
     (loop [dict dict]
@@ -41,7 +42,6 @@
 
   type?-tag   "type?"
   alias-tag   "alias"
-  macro?-tag  "macro?"
   export?-tag "export?"
   tags-tag    "tags"
   imports-tag "imports"
diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj
index 70e463432..b749b64e4 100644
--- a/luxc/src/lux/analyser/module.clj
+++ b/luxc/src/lux/analyser/module.clj
@@ -108,8 +108,8 @@
 
 (defn define [module name def-type def-meta def-value]
   (fn [state]
-    (when (and (= "Macro" name) (= "lux" module))
-      (&type/set-macro-type! def-value))
+    (when (and (= "Macro'" name) (= "lux" module))
+      (&type/set-macro*-type! def-value))
     (|case (&/get$ &/$scopes state)
       (&/$Cons ?env (&/$Nil))
       (return* (->> state
@@ -445,7 +445,6 @@
       (return nil)))
 
   test-type  &type/Type  &meta/type?-tag  "type"
-  test-macro &type/Macro &meta/macro?-tag "macro"
   )
 
 (defn fetch-imports [meta]
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index 75c2cd3c9..f055fc99c 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -22,13 +22,20 @@
     (fn [$var]
       (|do [:let [(&/$Cons op (&/$Nil)) ?values]
             =op (&&/analyse-1 analyse (&/$Apply $var &type/IO) op)
-            _ (&type/check exo-type (&/$Sum &type/Text ;; lux;Left
-                                            $var ;; lux;Right
+            _ (&type/check exo-type (&/$Sum &type/Text ;; lux.Left
+                                            $var ;; lux.Right
                                             ))
             _cursor &/cursor]
         (return (&/|list (&&/|meta exo-type _cursor
                                    (&&/$proc (&/T ["lux" "try"]) (&/|list =op) (&/|list)))))))))
 
+(defn- analyse-lux-macro [analyse exo-type ?values]
+  (|do [:let [(&/$Cons macro (&/$Nil)) ?values]
+        [[=macro*-type =cursor] =macro] (&&/analyse-1 analyse &type/Macro* macro)
+        _ (&type/check exo-type &type/Macro)]
+    (return (&/|list (&&/|meta exo-type =cursor
+                               =macro)))))
+
 (do-template [<name> <proc> <input-type> <output-type>]
   (defn- <name> [analyse exo-type ?values]
     (|do [:let [(&/$Cons reference (&/$Cons sample (&/$Nil))) ?values]
@@ -250,6 +257,7 @@
   (try (case proc
          "lux is"                   (analyse-lux-is analyse exo-type ?values)
          "lux try"                  (analyse-lux-try analyse exo-type ?values)
+         "lux macro" (analyse-lux-macro analyse exo-type ?values)
 
          "lux io log"                  (analyse-io-log analyse exo-type ?values)
          "lux io error"                (analyse-io-error analyse exo-type ?values)
diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj
index 7939d3717..20126417f 100644
--- a/luxc/src/lux/type.clj
+++ b/luxc/src/lux/type.clj
@@ -180,11 +180,12 @@
             (let [w (&/$Apply Cursor Meta)]
               (&/$Apply (&/$Apply w Code*) w))))
 
-(def Macro)
+(def Macro*)
+(defn set-macro*-type! [type] (def Macro* type))
 
-(defn set-macro-type! [type]
-  (def Macro type)
-  nil)
+(def Macro
+  (&/$Named (&/T ["lux" "Macro"])
+            (&/$Primitive "#Macro" &/$Nil)))
 
 (defn bound? [id]
   (fn [state]
@@ -232,7 +233,7 @@
         
         (&/$None)
         (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id (&/$Some type) %)
-                                                                ts))
+                                                               ts))
                             state)
                  nil))
       ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length)))
@@ -242,7 +243,7 @@
   (fn [state]
     (if-let [tvar (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))]
       (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id (&/$Some type) %)
-                                                              ts))
+                                                             ts))
                           state)
                nil)
       ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length)))
@@ -386,8 +387,9 @@
      (unravel-app fun-type &/$Nil)))
 
 (do-template [<tag> <flatten> <at> <desc>]
-  (do (defn <flatten> [type]
+  (do (defn <flatten>
         "(-> Type (List Type))"
+        [type]
         (|case type
           (<tag> left right)
           (&/$Cons left (<flatten> right))
@@ -395,8 +397,9 @@
           _
           (&/|list type)))
 
-    (defn <at> [tag type]
+    (defn <at>
       "(-> Int Type (Lux Type))"
+      [tag type]
       (|case type
         (&/$Named ?name ?type)
         (<at> tag ?type)
@@ -417,8 +420,9 @@
   )
 
 (do-template [<name> <ctor> <unit>]
-  (defn <name> [types]
+  (defn <name>
     "(-> (List Type) Type)"
+    [types]
     (|case (&/|reverse types)
       (&/$Cons last prevs)
       (&/fold (fn [right left] (<ctor> left right)) last prevs)
@@ -857,8 +861,9 @@
   (|do [_ (check* init-fixpoints false expected actual)]
     (return nil)))
 
-(defn actual-type [type]
+(defn actual-type
   "(-> Type (Lux Type))"
+  [type]
   (|case type
     (&/$Apply ?param ?all)
     (|do [type* (apply-type ?all ?param)]
@@ -875,8 +880,9 @@
     (return type)
     ))
 
-(defn type-name [type]
+(defn type-name
   "(-> Type (Lux Ident))"
+  [type]
   (|case type
     (&/$Named name _)
     (return name)
@@ -885,8 +891,9 @@
     (&/fail-with-loc (str "[Type Error] Type is not named: " (show-type type)))
     ))
 
-(defn unknown? [type]
+(defn unknown?
   "(-> Type (Lux Bit))"
+  [type]
   (|case type
     (&/$Var id)
     (|do [? (bound? id)]
@@ -895,8 +902,9 @@
     _
     (return false)))
 
-(defn resolve-type [type]
+(defn resolve-type
   "(-> Type (Lux Type))"
+  [type]
   (|case type
     (&/$Var id)
     (|do [? (bound? id)]
@@ -907,8 +915,9 @@
     _
     (return type)))
 
-(defn tuple-types-for [size-members type]
+(defn tuple-types-for
   "(-> Int Type [Int (List Type)])"
+  [size-members type]
   (|let [?member-types (flatten-prod type)
          size-types (&/|length ?member-types)]
     (if (>= size-types size-members)