From 0a0fab3581eedbc13df2af40e3db8bc2d2fd8178 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 30 Aug 2015 01:20:08 -0400
Subject: - Removed the (now obsolete) `' macro. - Implemented hygienic macros
 by adding global symbol resolution inside the ` macro.

---
 source/lux.lux | 789 ++++++++++++++++++++++++++++++---------------------------
 1 file changed, 413 insertions(+), 376 deletions(-)

(limited to 'source/lux.lux')

diff --git a/source/lux.lux b/source/lux.lux
index 3ba8ec897..0ce03829b 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -880,8 +880,22 @@
     _
     (fail "Wrong syntax for list&")))
 
+(defmacro #export (^ tokens)
+  (_lux_case tokens
+    (#Cons [_ (#SymbolS "" class-name)] #Nil)
+    (return (list (form$ (list (tag$ ["lux" "DataT"]) (text$ class-name)))))
+
+    _
+    (fail "Wrong syntax for ^")))
+
+(defmacro #export (, tokens)
+  (return (list (form$ (list (tag$ ["lux" "TupleT"])
+                             (foldL (lambda'' [tail head] (form$ (list (tag$ ["lux" "Cons"]) head tail)))
+                                    (tag$ ["lux" "Nil"])
+                                    (reverse tokens)))))))
+
 (defmacro (lambda' tokens)
-  (let'' [name tokens'] (_lux_: (#TupleT (list Text ($' List AST)))
+  (let'' [name tokens'] (_lux_: (, Text ($' List AST))
                                 (_lux_case tokens
                                   (#Cons [[_ (#SymbolS ["" name])] tokens'])
                                   [name tokens']
@@ -953,7 +967,7 @@
     ))
 
 (def''' (as-pairs xs)
-  (All [a] (-> ($' List a) ($' List (#TupleT (list a a)))))
+  (All [a] (-> ($' List a) ($' List (, a a))))
   (_lux_case xs
     (#Cons x (#Cons y xs'))
     (#Cons [x y] (as-pairs xs'))
@@ -964,7 +978,7 @@
 (defmacro (let' tokens)
   (_lux_case tokens
     (#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])])
-    (return (list (foldL (_lux_: (-> AST (#TupleT (list AST AST))
+    (return (list (foldL (_lux_: (-> AST (, AST AST)
                                      AST)
                                  (lambda' [body binding]
                                           (_lux_case binding
@@ -1009,8 +1023,7 @@
     (_meta (#TagS ["lux" "Nil"]))
 
     (#Cons [token tokens'])
-    (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
-                         (_meta (#TupleS (list token (untemplate-list tokens')))))))))
+    (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) token (untemplate-list tokens'))))))
 
 (def''' #export (list:++ xs ys)
   (All [a] (-> ($' List a) ($' List a) ($' List a)))
@@ -1031,140 +1044,12 @@
     _
     (fail "Wrong syntax for $")))
 
-(def''' (splice replace? untemplate tag elems)
-  (-> Bool (-> AST AST) AST ($' List AST) AST)
-  (_lux_case replace?
-    true
-    (_lux_case (any? spliced? elems)
-      true
-      (let' [elems' (map (lambda' [elem]
-                                  (_lux_case elem
-                                    [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))]
-                                    spliced
-
-                                    _
-                                    (form$ (list (symbol$ ["" "_lux_:"])
-                                                 (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"])))))
-                                                 (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list (untemplate elem)
-                                                                                                  (tag$ ["lux" "Nil"])))))))))
-                         elems)]
-            (wrap-meta (form$ (list tag
-                                    (form$ (list& (symbol$ ["lux" "$"])
-                                                  (symbol$ ["lux" "list:++"])
-                                                  elems'))))))
-
-      false
-      (wrap-meta (form$ (list tag (untemplate-list (map untemplate elems))))))
-    false
-    (wrap-meta (form$ (list tag (untemplate-list (map untemplate elems)))))))
-
-(def''' (untemplate replace? subst token)
-  (-> Bool Text AST AST)
-  (_lux_case (_lux_: (#TupleT (list Bool AST)) [replace? token])
-    [_ [_ (#BoolS value)]]
-    (wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))
-
-    [_ [_ (#IntS value)]]
-    (wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (_meta (#IntS value)))))
-
-    [_ [_ (#RealS value)]]
-    (wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (_meta (#RealS value)))))
-
-    [_ [_ (#CharS value)]]
-    (wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (_meta (#CharS value)))))
-
-    [_ [_ (#TextS value)]]
-    (wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value)))))
-
-    [_ [_ (#TagS [module name])]]
-    (let' [module' (_lux_case module
-                     ""
-                     subst
-
-                     _
-                     module)]
-          (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))
-
-    [_ [_ (#SymbolS [module name])]]
-    (let' [module' (_lux_case module
-                     ""
-                     subst
-
-                     _
-                     module)]
-          (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name)))))))
-
-    [_ [_ (#TupleS elems)]]
-    (splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
-
-    [true [_ (#FormS (#Cons [[_ (#SymbolS ["" "~"])] (#Cons [unquoted #Nil])]))]]
-    unquoted
-
-    [_ [meta (#FormS elems)]]
-    (let' [[_ form'] (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)]
-          [meta form'])
-
-    [_ [_ (#RecordS fields)]]
-    (wrap-meta (form$ (list (tag$ ["lux" "RecordS"])
-                            (untemplate-list (map (_lux_: (-> (#TupleT (list AST AST)) AST)
-                                                          (lambda' [kv]
-                                                                   (let' [[k v] kv]
-                                                                         (tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
-                                                  fields)))))
-    ))
-
-(defmacro (`' tokens)
-  (_lux_case tokens
-    (#Cons [template #Nil])
-    (return (list (untemplate true "" template)))
-
-    _
-    (fail "Wrong syntax for `'")))
-
-(defmacro #export (' tokens)
-  (_lux_case tokens
-    (#Cons [template #Nil])
-    (return (list (untemplate false "" template)))
-
-    _
-    (fail "Wrong syntax for '")))
-
-(defmacro #export (|> tokens)
-  (_lux_case tokens
-    (#Cons [init apps])
-    (return (list (foldL (_lux_: (-> AST AST AST)
-                                 (lambda' [acc app]
-                                          (_lux_case app
-                                            [_ (#TupleS parts)]
-                                            (tuple$ (list:++ parts (list acc)))
-
-                                            [_ (#FormS parts)]
-                                            (form$ (list:++ parts (list acc)))
-
-                                            _
-                                            (`' ((~ app) (~ acc))))))
-                         init
-                         apps)))
-
-    _
-    (fail "Wrong syntax for |>")))
-
-(defmacro #export (if tokens)
-  (_lux_case tokens
-    (#Cons [test (#Cons [then (#Cons [else #Nil])])])
-    (return (list (`' (_lux_case (~ test)
-                        true  (~ then)
-                        false (~ else)))))
-
-    _
-    (fail "Wrong syntax for if")))
-
 ## (deftype (Lux a)
 ##   (-> Compiler (Either Text (, Compiler a))))
 (def''' #export Lux
   Type
   (All [a]
-    (-> Compiler ($' Either Text (#TupleT (list Compiler a))))))
+    (-> Compiler ($' Either Text (, Compiler a)))))
 
 ## (defsig (Monad m)
 ##   (: (All [a] (-> a (m a)))
@@ -1175,10 +1060,10 @@
   Type
   (#NamedT ["lux" "Monad"]
            (All [m]
-             (#TupleT (list (All [a] (-> a ($' m a)))
-                            (All [a b] (-> (-> a ($' m b))
-                                           ($' m a)
-                                           ($' m b))))))))
+             (, (All [a] (-> a ($' m a)))
+                (All [a b] (-> (-> a ($' m b))
+                               ($' m a)
+                               ($' m b)))))))
 (_lux_declare-tags [#return #bind] Monad)
 
 (def''' Maybe/Monad
@@ -1210,37 +1095,28 @@
                        (#Right state' a)
                        (f a state'))))})
 
-(defmacro #export (^ tokens)
-  (_lux_case tokens
-    (#Cons [_ (#SymbolS "" class-name)] #Nil)
-    (return (list (`' (#;DataT (~ (_meta (#TextS class-name)))))))
-
-    _
-    (fail "Wrong syntax for ^")))
-
-(defmacro #export (, tokens)
-  (return (list (`' (#;TupleT (~ (untemplate-list tokens)))))))
-
 (defmacro (do tokens)
   (_lux_case tokens
     (#Cons monad (#Cons [_ (#TupleS bindings)] (#Cons body #Nil)))
-    (let' [body' (foldL (_lux_: (-> AST (, AST AST) AST)
+    (let' [g!wrap (symbol$ ["" "wrap"])
+           g!bind (symbol$ ["" "12bind34"])
+           body' (foldL (_lux_: (-> AST (, AST AST) AST)
                                 (lambda' [body' binding]
                                          (let' [[var value] binding]
                                                (_lux_case var
                                                  [_ (#TagS "" "let")]
-                                                 (`' (;let' (~ value) (~ body')))
+                                                 (form$ (list (symbol$ ["lux" "let'"]) value body'))
 
                                                  _
-                                                 (`' (bind (_lux_lambda (~ (symbol$ ["" ""]))
-                                                             (~ var)
-                                                             (~ body'))
-                                                           (~ value)))))))
+                                                 (form$ (list g!bind
+                                                              (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body'))
+                                                              value))))))
                         body
                         (reverse (as-pairs bindings)))]
-          (return (list (`' (_lux_case (~ monad)
-                              {#;return wrap #;bind bind}
-                              (~ body'))))))
+          (return (list (form$ (list (symbol$ ["" "_lux_case"])
+                                     monad
+                                     (record$ (list [(tag$ ["lux" "return"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind]))
+                                     body')))))
 
     _
     (fail "Wrong syntax for do")))
@@ -1265,6 +1141,232 @@
             (wrap (#Cons y ys)))
           )))
 
+(defmacro #export (if tokens)
+  (_lux_case tokens
+    (#Cons test (#Cons then (#Cons else #Nil)))
+    (return (list (form$ (list (symbol$ ["" "_lux_case"]) test
+                               (bool$ true)  then
+                               (bool$ false) else))))
+
+    _
+    (fail "Wrong syntax for if")))
+
+(def''' (get k plist)
+  (All [a]
+    (-> Text ($' List (, Text a)) ($' Maybe a)))
+  (_lux_case plist
+    (#Cons [[k' v] plist'])
+    (if (text:= k k')
+      (#Some v)
+      (get k plist'))
+
+    #Nil
+    #None))
+
+(def''' (put k v dict)
+  (All [a]
+    (-> Text a ($' List (, Text a)) ($' List (, Text a))))
+  (_lux_case dict
+    #Nil
+    (list [k v])
+
+    (#Cons [[k' v'] dict'])
+    (if (text:= k k')
+      (#Cons [[k' v] dict'])
+      (#Cons [[k' v'] (put k v dict')]))))
+
+(def''' (text:++ x y)
+  (-> Text Text Text)
+  (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"]
+                      x [y]))
+
+(def''' (ident->text ident)
+  (-> Ident Text)
+  (let' [[module name] ident]
+        ($ text:++ module ";" name)))
+
+(def''' (resolve-global-symbol ident state)
+  (-> Ident ($' Lux Ident))
+  (let' [[module name] ident
+         {#source source #modules modules
+          #envs   envs   #type-vars   types   #host           host
+          #seed   seed   #eval? eval? #expected expected
+          #cursor cursor} state]
+        (_lux_case (get module modules)
+          (#Some {#module-aliases _ #defs defs #imports _ #tags tags #types types})
+          (_lux_case (get name defs)
+            (#Some [_ def-data])
+            (_lux_case def-data
+              (#AliasD real-name)
+              (#Right [state real-name])
+
+              _
+              (#Right [state ident]))
+
+            #None
+            (#Left ($ text:++ "Unknown definition: " (ident->text ident))))
+          
+          #None
+          (#Left ($ text:++ "Unknown module: " module " @ " (ident->text ident))))))
+
+(def''' (splice replace? untemplate tag elems)
+  (-> Bool (-> AST ($' Lux AST)) AST ($' List AST) ($' Lux AST))
+  (_lux_case replace?
+    true
+    (_lux_case (any? spliced? elems)
+      true
+      (do Lux/Monad
+        [elems' (_lux_: ($' Lux ($' List AST))
+                        (map% Lux/Monad
+                              (_lux_: (-> AST ($' Lux AST))
+                                      (lambda' [elem]
+                                               (_lux_case elem
+                                                 [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))]
+                                                 (wrap spliced)
+
+                                                 _
+                                                 (do Lux/Monad
+                                                   [=elem (untemplate elem)]
+                                                   (wrap (form$ (list (symbol$ ["" "_lux_:"])
+                                                                      (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"])))))
+                                                                      (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"]))))))))))))
+                              elems))]
+        (wrap (wrap-meta (form$ (list tag
+                                      (form$ (list& (symbol$ ["lux" "$"])
+                                                    (symbol$ ["lux" "list:++"])
+                                                    elems')))))))
+
+      false
+      (do Lux/Monad
+        [=elems (map% Lux/Monad untemplate elems)]
+        (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))
+    false
+    (do Lux/Monad
+      [=elems (map% Lux/Monad untemplate elems)]
+      (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))))
+
+(def''' (untemplate replace? subst token)
+  (-> Bool Text AST ($' Lux AST))
+  (_lux_case (_lux_: (, Bool AST) [replace? token])
+    [_ [_ (#BoolS value)]]
+    (return (wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value))))))
+
+    [_ [_ (#IntS value)]]
+    (return (wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (_meta (#IntS value))))))
+
+    [_ [_ (#RealS value)]]
+    (return (wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (_meta (#RealS value))))))
+
+    [_ [_ (#CharS value)]]
+    (return (wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (_meta (#CharS value))))))
+
+    [_ [_ (#TextS value)]]
+    (return (wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value))))))
+
+    [_ [_ (#TagS [module name])]]
+    (let' [module' (_lux_case module
+                     ""
+                     subst
+
+                     _
+                     module)]
+          (return (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name))))))))
+
+    [true [_ (#SymbolS [module name])]]
+    (do Lux/Monad
+      [real-name (_lux_case module
+                   ""
+                   (resolve-global-symbol [subst name])
+
+                   _
+                   (wrap (_lux_: Ident [module name])))
+       #let [[module name] real-name]]
+      (return (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module) (text$ name))))))))
+
+    [false [_ (#SymbolS [module name])]]
+    (return (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module) (text$ name)))))))
+
+    [_ [_ (#TupleS elems)]]
+    (splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
+
+    [true [_ (#FormS (#Cons [[_ (#SymbolS ["" "~"])] (#Cons [unquoted #Nil])]))]]
+    (return unquoted)
+
+    [_ [meta (#FormS elems)]]
+    (do Lux/Monad
+      [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)
+       #let [[_ form'] output]]
+      (return (_lux_: AST [meta form'])))
+
+    [_ [_ (#RecordS fields)]]
+    (do Lux/Monad
+      [=fields (map% Lux/Monad
+                     (_lux_: (-> (, AST AST) ($' Lux AST))
+                             (lambda' [kv]
+                                      (let' [[k v] kv]
+                                            (do Lux/Monad
+                                              [=k (untemplate replace? subst k)
+                                               =v (untemplate replace? subst v)]
+                                              (wrap (tuple$ (list =k =v)))))))
+                     fields)]
+      (wrap (wrap-meta (form$ (list (tag$ ["lux" "RecordS"]) (untemplate-list =fields))))))
+    ))
+
+(def'' (get-module-name state)
+  ($' Lux Text)
+  (_lux_case state
+    {#source source #modules modules
+     #envs   envs   #type-vars   types   #host     host
+     #seed   seed   #eval?   eval?   #expected expected
+     #cursor cursor}
+    (_lux_case (reverse envs)
+      #Nil
+      (#Left "Can't get the module name without a module!")
+
+      (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _])
+      (#Right [state module-name]))))
+
+(defmacro #export (` tokens)
+  (_lux_case tokens
+    (#Cons template #Nil)
+    (do Lux/Monad
+      [current-module get-module-name
+       =template (untemplate true current-module template)]
+      (wrap (list =template)))
+
+    _
+    (fail "Wrong syntax for `")))
+
+(defmacro #export (' tokens)
+  (_lux_case tokens
+    (#Cons template #Nil)
+    (do Lux/Monad
+      [=template (untemplate false "" template)]
+      (wrap (list =template)))
+
+    _
+    (fail "Wrong syntax for '")))
+
+(defmacro #export (|> tokens)
+  (_lux_case tokens
+    (#Cons [init apps])
+    (return (list (foldL (_lux_: (-> AST AST AST)
+                                 (lambda' [acc app]
+                                          (_lux_case app
+                                            [_ (#TupleS parts)]
+                                            (tuple$ (list:++ parts (list acc)))
+
+                                            [_ (#FormS parts)]
+                                            (form$ (list:++ parts (list acc)))
+
+                                            _
+                                            (` ((~ app) (~ acc))))))
+                         init
+                         apps)))
+
+    _
+    (fail "Wrong syntax for |>")))
+
 (def''' (. f g)
   (All [a b c]
     (-> (-> b c) (-> a b) (-> a c)))
@@ -1409,58 +1511,10 @@
   (-> Bool Bool)
   (if x false true))
 
-(def''' (text:++ x y)
-  (-> Text Text Text)
-  (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"]
-                      x [y]))
-
-(def''' (ident->text ident)
-  (-> Ident Text)
-  (let' [[module name] ident]
-        ($ text:++ module ";" name)))
-
-(def''' (get k plist)
-  (All [a]
-    (-> Text ($' List (, Text a)) ($' Maybe a)))
-  (_lux_case plist
-    (#Cons [[k' v] plist'])
-    (if (text:= k k')
-      (#Some v)
-      (get k plist'))
-
-    #Nil
-    #None))
-
-(def''' (put k v dict)
-  (All [a]
-    (-> Text a ($' List (, Text a)) ($' List (, Text a))))
-  (_lux_case dict
-    #Nil
-    (list [k v])
-
-    (#Cons [[k' v'] dict'])
-    (if (text:= k k')
-      (#Cons [[k' v] dict'])
-      (#Cons [[k' v'] (put k v dict')]))))
-
 (def''' (->text x)
   (-> (^ java.lang.Object) Text)
   (_jvm_invokevirtual "java.lang.Object" "toString" [] x []))
 
-(def''' (get-module-name state)
-  ($' Lux Text)
-  (_lux_case state
-    {#source source #modules modules
-     #envs   envs   #type-vars   types   #host     host
-     #seed   seed   #eval?   eval?   #expected expected
-     #cursor cursor}
-    (_lux_case (reverse envs)
-      #Nil
-      (#Left "Can't get the module name without a module!")
-
-      (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _])
-      (#Right [state module-name]))))
-
 (def''' (find-macro' modules current-module module name)
   (-> ($' List (, Text ($' Module Compiler)))
       Text Text Text
@@ -1589,7 +1643,7 @@
 
     [_ (#FormS (#Cons [type-fn args]))]
     (foldL (_lux_: (-> AST AST AST)
-                   (lambda' [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))))
+                   (lambda' [type-fn arg] (` (#;AppT [(~ type-fn) (~ arg)]))))
            (walk-type type-fn)
            (map walk-type args))
     
@@ -1614,7 +1668,7 @@
 (defmacro #export (: tokens)
   (_lux_case tokens
     (#Cons type (#Cons value #Nil))
-    (return (list (`' (_lux_: (;type (~ type)) (~ value)))))
+    (return (list (` (;_lux_: (;type (~ type)) (~ value)))))
 
     _
     (fail "Wrong syntax for :")))
@@ -1622,7 +1676,7 @@
 (defmacro #export (:! tokens)
   (_lux_case tokens
     (#Cons type (#Cons value #Nil))
-    (return (list (`' (_lux_:! (;type (~ type)) (~ value)))))
+    (return (list (` (;_lux_:! (type (~ type)) (~ value)))))
 
     _
     (fail "Wrong syntax for :!")))
@@ -1651,7 +1705,7 @@
                         (lambda' [case]
                                  (_lux_case case
                                    [_ (#TagS "" member-name)]
-                                   (return [member-name (`' Unit)])
+                                   (return [member-name (` Unit)])
                                    
                                    [_ (#FormS (#Cons [_ (#TagS "" member-name)] (#Cons member-type #Nil)))]
                                    (return [member-name member-type])
@@ -1659,7 +1713,7 @@
                                    _
                                    (fail "Wrong syntax for variant case."))))
                      cases)]
-      (return [(`' (#;VariantT (~ (untemplate-list (map second members)))))
+      (return [(` (#;VariantT (~ (untemplate-list (map second members)))))
                (#Some (|> members
                           (map first)
                           (map (: (-> Text AST)
@@ -1677,7 +1731,7 @@
                                    _
                                    (fail "Wrong syntax for variant case."))))
                      (as-pairs pairs))]
-      (return [(`' (#TupleT (~ (untemplate-list (map second members)))))
+      (return [(` (#TupleT (~ (untemplate-list (map second members)))))
                (#Some (|> members
                           (map first)
                           (map (: (-> Text AST)
@@ -1720,12 +1774,12 @@
                    [type tags??] type+tags??
                    with-export (: (List AST)
                                   (if export?
-                                    (list (`' (_lux_export (~ type-name))))
+                                    (list (` (;_lux_export (~ type-name))))
                                     #Nil))
                    with-tags (: (List AST)
                                 (_lux_case tags??
                                   (#Some tags)
-                                  (list (`' (_lux_declare-tags [(~@ tags)] (~ type-name))))
+                                  (list (` (;_lux_declare-tags [(~@ tags)] (~ type-name))))
 
                                   _
                                   (list)))
@@ -1734,21 +1788,21 @@
                               (if (empty? args)
                                 (let' [g!param (symbol$ ["" ""])
                                        prime-name (symbol$ ["" (text:++ name "'")])
-                                       type+ (replace-syntax (list [name (`' ((~ prime-name) (~ g!param)))]) type)]
-                                      (#Some (`' ((;All (~ prime-name) [(~ g!param)] (~ type+))
-                                                  ;Void))))
+                                       type+ (replace-syntax (list [name (` ((~ prime-name) (~ g!param)))]) type)]
+                                      (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+))
+                                                 Void))))
                                 #None)
                               (_lux_case args
                                 #Nil
                                 (#Some type)
 
                                 _
-                                (#Some (`' (;All (~ type-name) [(~@ args)] (~ type)))))))]
+                                (#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))]
                   (_lux_case type'
                     (#Some type'')
-                    (return (list& (`' (_lux_def (~ type-name) (;type (#;NamedT [(~ (text$ module-name))
-                                                                                 (~ (text$ name))]
-                                                                                (~ type'')))))
+                    (return (list& (` (;_lux_def (~ type-name) (type (#;NamedT [(~ (text$ module-name))
+                                                                                (~ (text$ name))]
+                                                                               (~ type'')))))
                                    (list:++ with-export with-tags)))
 
                     #None
@@ -1763,7 +1817,7 @@
     (#Cons value actions)
     (let' [dummy (symbol$ ["" ""])]
           (return (list (foldL (_lux_: (-> AST AST AST)
-                                       (lambda' [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post)))))
+                                       (lambda' [post pre] (` (;_lux_case (~ pre) (~ dummy) (~ post)))))
                                value
                                actions))))
 
@@ -1802,17 +1856,17 @@
                             body
 
                             _
-                            (`' (;lambda' (~ name) [(~@ args)] (~ body)))))
+                            (` (lambda' (~ name) [(~@ args)] (~ body)))))
                  body'' (: AST
                            (_lux_case ?type
                              (#Some type)
-                             (`' (: (~ type) (~ body')))
+                             (` (: (~ type) (~ body')))
                              
                              #None
                              body'))]
-                (return (list& (`' (_lux_def (~ name) (~ body'')))
+                (return (list& (` (;_lux_def (~ name) (~ body'')))
                                (if export?
-                                 (list (`' (_lux_export (~ name))))
+                                 (list (` (;_lux_export (~ name))))
                                  #Nil))))
           
           #None
@@ -1841,8 +1895,8 @@
                                             _
                                             (wrap (list branch))))))
                         (as-pairs branches))]
-      (wrap (list (`' (_lux_case (~ value)
-                        (~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
+      (wrap (list (` (;_lux_case (~ value)
+                                 (~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
 
     _
     (fail "Wrong syntax for case")))
@@ -1878,16 +1932,6 @@
     _
     (fail "Wrong syntax for \\or")))
 
-(defmacro #export (` tokens)
-  (do Lux/Monad
-    [module-name get-module-name]
-    (case tokens
-      (\ (list template))
-      (wrap (list (untemplate true module-name template)))
-
-      _
-      (fail "Wrong syntax for `"))))
-
 (def' (symbol? ast)
   (-> AST Bool)
   (case ast
@@ -1906,7 +1950,7 @@
                     (lambda' [body' lr]
                              (let' [[l r] lr]
                                    (if (symbol? l)
-                                     (` (_lux_case (~ r) (~ l) (~ body')))
+                                     (` (;_lux_case (~ r) (~ l) (~ body')))
                                      (` (case (~ r) (~ l) (~ body')))))))
                  body)
           list
@@ -1969,14 +2013,14 @@
           body+ (: AST (foldL (: (-> AST AST AST)
                                  (lambda' [body' arg]
                                           (if (symbol? arg)
-                                            (` (_lux_lambda (~ g!blank) (~ arg) (~ body')))
-                                            (` (_lux_lambda (~ g!blank) (~ g!blank)
-                                                 (case (~ g!blank) (~ arg) (~ body')))))))
+                                            (` (;_lux_lambda (~ g!blank) (~ arg) (~ body')))
+                                            (` (;_lux_lambda (~ g!blank) (~ g!blank)
+                                                        (case (~ g!blank) (~ arg) (~ body')))))))
                               body
                               (reverse tail)))]
       (return (list (if (symbol? head)
-                      (` (_lux_lambda (~ g!name) (~ head) (~ body+)))
-                      (` (_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
+                      (` (;_lux_lambda (~ g!name) (~ head) (~ body+)))
+                      (` (;_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
 
     #None
     (fail "Wrong syntax for lambda")))
@@ -2013,7 +2057,7 @@
                       body
 
                       _
-                      (` (;lambda (~ name) [(~@ args)] (~ body)))))
+                      (` (lambda (~ name) [(~@ args)] (~ body)))))
             body (: AST
                     (case ?type
                       (#Some type)
@@ -2021,9 +2065,9 @@
                       
                       #None
                       body))]
-        (return (list& (` (_lux_def (~ name) (~ body)))
+        (return (list& (` (;_lux_def (~ name) (~ body)))
                        (if export?
-                         (list (` (_lux_export (~ name))))
+                         (list (` (;_lux_export (~ name))))
                          (list)))))
       
       #None
@@ -2079,19 +2123,19 @@
                def-name (symbol$ name)
                tags (: (List AST) (map (. (: (-> Text AST) (lambda [n] (tag$ ["" n]))) first) members))
                types (map second members)
-               sig-type (: AST (` (#;TupleT (~ (untemplate-list types)))))
-               sig-decl (: AST (` (_lux_declare-tags [(~@ tags)] (~ def-name))))
+               sig-type (: AST (` (#TupleT (~ (untemplate-list types)))))
+               sig-decl (: AST (` (;_lux_declare-tags [(~@ tags)] (~ def-name))))
                sig+ (: AST
                        (case args
                          #Nil
                          sig-type
 
                          _
-                         (` (#;NamedT [(~ (text$ _module)) (~ (text$ _name))] (;All (~ def-name) [(~@ args)] (~ sig-type))))))]]
-        (return (list& (` (_lux_def (~ def-name) (~ sig+)))
+                         (` (#NamedT [(~ (text$ _module)) (~ (text$ _name))] (;All (~ def-name) [(~@ args)] (~ sig-type))))))]]
+        (return (list& (` (;_lux_def (~ def-name) (~ sig+)))
                        sig-decl
                        (if export?
-                         (list (` (_lux_export (~ def-name))))
+                         (list (` (;_lux_export (~ def-name))))
                          #Nil))))
 
       #None
@@ -2370,29 +2414,22 @@
      #let [tag-mappings (: (List (, Text AST))
                            (map (lambda [tag] [(second tag) (tag$ tag)])
                                 tags))]
-     _ (: (Lux Unit)
-          (let [msg ($ text:++ "struct/tag-mappings: " "[" (|> tag-mappings (map first) (interpose " ") (foldL text:++ "")) "]" " " (type:show struct-type))
-                _ (_jvm_invokevirtual "java.io.PrintStream" "println" ["java.lang.Object"]
-                                      (_jvm_getstatic "java.lang.System" "out") [msg])]
-            (return (: Unit []))))
-     ]
-    (do Lux/Monad
-      [members (map% Lux/Monad
-                     (: (-> AST (Lux (, AST AST)))
-                        (lambda [token]
-                          (case token
-                            (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))])
-                            (case (get tag-name tag-mappings)
-                              (#Some tag)
-                              (wrap (: (, AST AST) [tag value]))
-
-                              _
-                              (fail (text:++ "Unknown structure member: " tag-name)))
+     members (map% Lux/Monad
+                   (: (-> AST (Lux (, AST AST)))
+                      (lambda [token]
+                        (case token
+                          (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))])
+                          (case (get tag-name tag-mappings)
+                            (#Some tag)
+                            (wrap (: (, AST AST) [tag value]))
 
                             _
-                            (fail (text:++ "Invalid structure member: " (ast:show token))))))
-                     (list:join tokens'))]
-      (wrap (list (record$ members))))))
+                            (fail (text:++ "Unknown structure member: " tag-name)))
+
+                          _
+                          (fail (text:++ "Invalid structure member: " (ast:show token))))))
+                   (list:join tokens'))]
+    (wrap (list (record$ members)))))
 
 (defmacro #export (defstruct tokens)
   (let [[export? tokens'] (: (, Bool (List AST))
@@ -2417,13 +2454,13 @@
       (let [defs' (: AST
                      (case args
                        #Nil
-                       (` (;struct (~@ defs)))
+                       (` (struct (~@ defs)))
 
                        _
-                       (` (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
+                       (` (lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
         (return (list& (` (def (~ name) (~ type) (~ defs')))
                        (if export?
-                         (list (` (_lux_export (~ name))))
+                         (list (` (;_lux_export (~ name))))
                          #Nil))))
 
       #None
@@ -2670,85 +2707,6 @@
                       cases)]
     output))
 
-(defmacro #export (import tokens)
-  (do Lux/Monad
-    [imports (parse-imports tokens)
-     imports (map% Lux/Monad
-                   (: (-> Import (Lux Import))
-                      (lambda [import]
-                        (case import
-                          [m-name m-alias m-referrals m-openings]
-                          (do Lux/Monad
-                            [m-name (clean-module m-name)]
-                            (wrap (: Import [m-name m-alias m-referrals m-openings]))))))
-                   imports)
-     unknowns' (map% Lux/Monad
-                     (: (-> Import (Lux (List Text)))
-                        (lambda [import]
-                          (case import
-                            [m-name _ _ _]
-                            (do Lux/Monad
-                              [? (module-exists? m-name)]
-                              (wrap (if ?
-                                      (list)
-                                      (list m-name)))))))
-                     imports)
-     #let [unknowns (list:join unknowns')]]
-    (case unknowns
-      #Nil
-      (do Lux/Monad
-        [output' (map% Lux/Monad
-                       (: (-> Import (Lux (List AST)))
-                          (lambda [import]
-                            (case import
-                              [m-name m-alias m-referrals m-openings]
-                              (do Lux/Monad
-                                [defs (case m-referrals
-                                        #All
-                                        (exported-defs m-name)
-
-                                        (#Only +defs)
-                                        (do Lux/Monad
-                                          [*defs (exported-defs m-name)]
-                                          (wrap (filter (is-member? +defs) *defs)))
-                                        
-                                        (#Exclude -defs)
-                                        (do Lux/Monad
-                                          [*defs (exported-defs m-name)]
-                                          (wrap (filter (. not (is-member? -defs)) *defs)))
-
-                                        #Nothing
-                                        (wrap (list)))
-                                 #let [openings (: (List AST)
-                                                   (case m-openings
-                                                     #None
-                                                     (list)
-
-                                                     (#Some prefix structs)
-                                                     (map (: (-> Ident AST)
-                                                             (lambda [struct]
-                                                               (let [[_ name] struct]
-                                                                 (` (open (~ (symbol$ [m-name name])) (~ (text$ prefix)))))))
-                                                          structs)))]]
-                                (wrap ($ list:++
-                                        (: (List AST) (list (` (_lux_import (~ (text$ m-name))))))
-                                        (: (List AST)
-                                           (case m-alias
-                                             #None         (list)
-                                             (#Some alias) (list (` (_lux_alias (~ (text$ alias)) (~ (text$ m-name)))))))
-                                        (map (: (-> Text AST)
-                                                (lambda [def]
-                                                  (` (_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
-                                             defs)
-                                        openings))))))
-                       imports)]
-        (wrap (list:join output')))
-
-      _
-      (wrap (list:++ (map (: (-> Text AST) (lambda [m-name] (` (_lux_import (~ (text$ m-name))))))
-                          unknowns)
-                     (: (List AST) (list (` (import (~@ tokens))))))))))
-
 (def (try-both f x1 x2)
   (All [a b]
     (-> (-> a (Maybe b)) a a (Maybe b)))
@@ -2895,17 +2853,17 @@
                                       (lambda [[sname stype]] (use-field sname stype)))
                          (zip2 tags members))
              #let [pattern (record$ slots)]]
-            (return (list (` (_lux_case (~ struct) (~ pattern) (~ body))))))
+            (return (list (` (;_lux_case (~ struct) (~ pattern) (~ body))))))
 
           _
           (fail "Can only \"use\" records.")))
       
       _
       (let [dummy (symbol$ ["" ""])]
-        (return (list (` (_lux_case (~ struct)
-                           (~ dummy)
-                           (using (~ dummy)
-                             (~ body))))))))
+        (return (list (` (;_lux_case (~ struct)
+                                     (~ dummy)
+                                     (;using (~ dummy)
+                                             (~ body))))))))
 
     _
     (fail "Wrong syntax for using")))
@@ -2961,7 +2919,7 @@
                                                                      g!output
                                                                      g!_)]))
                                     (zip2 tags (enumerate members))))]
-          (return (list (` (_lux_case (~ record) (~ pattern) (~ g!output))))))
+          (return (list (` (;_lux_case (~ record) (~ pattern) (~ g!output))))))
 
         _
         (fail "get@ can only use records.")))
@@ -2984,7 +2942,7 @@
         (return (list:join decls')))
 
       _
-      (return (list (` (_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+))))))))
+      (return (list (` (;_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+))))))))
 
 (defmacro #export (open tokens)
   (case tokens
@@ -3014,6 +2972,85 @@
     _
     (fail "Wrong syntax for open")))
 
+(defmacro #export (import tokens)
+  (do Lux/Monad
+    [imports (parse-imports tokens)
+     imports (map% Lux/Monad
+                   (: (-> Import (Lux Import))
+                      (lambda [import]
+                        (case import
+                          [m-name m-alias m-referrals m-openings]
+                          (do Lux/Monad
+                            [m-name (clean-module m-name)]
+                            (wrap (: Import [m-name m-alias m-referrals m-openings]))))))
+                   imports)
+     unknowns' (map% Lux/Monad
+                     (: (-> Import (Lux (List Text)))
+                        (lambda [import]
+                          (case import
+                            [m-name _ _ _]
+                            (do Lux/Monad
+                              [? (module-exists? m-name)]
+                              (wrap (if ?
+                                      (list)
+                                      (list m-name)))))))
+                     imports)
+     #let [unknowns (list:join unknowns')]]
+    (case unknowns
+      #Nil
+      (do Lux/Monad
+        [output' (map% Lux/Monad
+                       (: (-> Import (Lux (List AST)))
+                          (lambda [import]
+                            (case import
+                              [m-name m-alias m-referrals m-openings]
+                              (do Lux/Monad
+                                [defs (case m-referrals
+                                        #All
+                                        (exported-defs m-name)
+
+                                        (#Only +defs)
+                                        (do Lux/Monad
+                                          [*defs (exported-defs m-name)]
+                                          (wrap (filter (is-member? +defs) *defs)))
+                                        
+                                        (#Exclude -defs)
+                                        (do Lux/Monad
+                                          [*defs (exported-defs m-name)]
+                                          (wrap (filter (. not (is-member? -defs)) *defs)))
+
+                                        #Nothing
+                                        (wrap (list)))
+                                 #let [openings (: (List AST)
+                                                   (case m-openings
+                                                     #None
+                                                     (list)
+
+                                                     (#Some prefix structs)
+                                                     (map (: (-> Ident AST)
+                                                             (lambda [struct]
+                                                               (let [[_ name] struct]
+                                                                 (` (open (~ (symbol$ [m-name name])) (~ (text$ prefix)))))))
+                                                          structs)))]]
+                                (wrap ($ list:++
+                                        (: (List AST) (list (` (;_lux_import (~ (text$ m-name))))))
+                                        (: (List AST)
+                                           (case m-alias
+                                             #None         (list)
+                                             (#Some alias) (list (` (;_lux_alias (~ (text$ alias)) (~ (text$ m-name)))))))
+                                        (map (: (-> Text AST)
+                                                (lambda [def]
+                                                  (` (;_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
+                                             defs)
+                                        openings))))))
+                       imports)]
+        (wrap (list:join output')))
+
+      _
+      (wrap (list:++ (map (: (-> Text AST) (lambda [m-name] (` (;_lux_import (~ (text$ m-name))))))
+                          unknowns)
+                     (: (List AST) (list (` (;import (~@ tokens))))))))))
+
 (def (foldL% M f x ys)
   (All [m a b]
     (-> (Monad m) (-> a b (m a)) a (List b)
@@ -3077,7 +3114,7 @@
                                                                 value
                                                                 r-var)]))
                                      pattern'))]
-            (return (list (` (_lux_case (~ record) (~ pattern) (~ output)))))))
+            (return (list (` (;_lux_case (~ record) (~ pattern) (~ output)))))))
 
         _
         (fail "set@ can only use records.")))
@@ -3112,7 +3149,7 @@
                                                                 (` ((~ fun) (~ r-var)))
                                                                 r-var)]))
                                      pattern'))]
-            (return (list (` (_lux_case (~ record) (~ pattern) (~ output)))))))
+            (return (list (` (;_lux_case (~ record) (~ pattern) (~ output)))))))
 
         _
         (fail "update@ can only use records.")))
@@ -3169,35 +3206,35 @@
   (-> Type AST)
   (case type
     (#DataT name)
-    (` (#;DataT (~ (text$ name))))
+    (` (#DataT (~ (text$ name))))
     
     (#;VariantT cases)
-    (` (#;VariantT (~ (untemplate-list (map type->syntax cases)))))
+    (` (#VariantT (~ (untemplate-list (map type->syntax cases)))))
 
     (#TupleT parts)
-    (` (#;TupleT (~ (untemplate-list (map type->syntax parts)))))
+    (` (#TupleT (~ (untemplate-list (map type->syntax parts)))))
     
     (#LambdaT in out)
-    (` (#;LambdaT (~ (type->syntax in)) (~ (type->syntax out))))
+    (` (#LambdaT (~ (type->syntax in)) (~ (type->syntax out))))
     
     (#BoundT idx)
-    (` (#;BoundT (~ (int$ idx))))
+    (` (#BoundT (~ (int$ idx))))
     
     (#VarT id)
-    (` (#;VarT (~ (int$ id))))
+    (` (#VarT (~ (int$ id))))
 
     (#ExT id)
-    (` (#;ExT (~ (int$ id))))
+    (` (#ExT (~ (int$ id))))
     
     (#UnivQ env type)
     (let [env' (untemplate-list (map type->syntax env))]
-      (` (#;UnivQ (~ env') (~ (type->syntax type)))))
+      (` (#UnivQ (~ env') (~ (type->syntax type)))))
     
     (#AppT fun arg)
-    (` (#;AppT (~ (type->syntax fun)) (~ (type->syntax arg))))
+    (` (#AppT (~ (type->syntax fun)) (~ (type->syntax arg))))
 
     (#NamedT [module name] type)
-    (` (#;NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->syntax type))))))
+    (` (#NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->syntax type))))))
 
 (defmacro #export (loop tokens)
   (case tokens
@@ -3224,14 +3261,14 @@
                             (lambda [_] (gensym "")))
                          inits)]
           (return (list (` (let [(~@ (interleave aliases inits))]
-                             (loop [(~@ (interleave vars aliases))]
+                             (;loop [(~@ (interleave vars aliases))]
                                (~ body)))))))))
 
     _
     (fail "Wrong syntax for loop")))
 
 (defmacro #export (export tokens)
-  (return (map (: (-> AST AST) (lambda [token] (` (_lux_export (~ token))))) tokens)))
+  (return (map (: (-> AST AST) (lambda [token] (` (;_lux_export (~ token))))) tokens)))
 
 (defmacro #export (\slots tokens)
   (case tokens
-- 
cgit v1.2.3