Merge pull request #42 from LuxLang/context_sensitive_macro_expansion

Context sensitive macro expansion

14 files changed, 66 insertions, 49 deletions

diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index 107d4979e..e33f51927 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -75,7 +75,7 @@
 
 (def: #export (procedure name args)
   (-> Text (List Analysis) Analysis)
-  (` ((~ (code.text name)) (~@ args))))
+  (` ((~ (code.text name)) (~+ args))))
 
 (def: #export (var idx)
   (-> Variable Analysis)
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux
index 16f775907..c40bb2ac3 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/new-luxc/source/luxc/lang/analysis/case.lux
@@ -214,7 +214,7 @@
                                              [nextA next]
                                              (wrap [(list) nextA]))
                                            (list.reverse matches))]
-              (wrap [(` ("lux case tuple" [(~@ memberP+)]))
+              (wrap [(` ("lux case tuple" [(~+ memberP+)]))
                      thenA])))
 
           _
@@ -250,12 +250,12 @@
                 (do macro.Monad<Meta>
                   [[testP nextA] (analyse-pattern #.None
                                                   (type.variant (list.drop (n/dec num-cases) flat-sum))
-                                                  (` [(~@ values)])
+                                                  (` [(~+ values)])
                                                   next)]
                   (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
                          nextA]))
                 (do macro.Monad<Meta>
-                  [[testP nextA] (analyse-pattern #.None case-type (` [(~@ values)]) next)]
+                  [[testP nextA] (analyse-pattern #.None case-type (` [(~+ values)]) next)]
                   (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
                          nextA])))
 
@@ -274,7 +274,7 @@
          [idx group variantT] (macro.resolve-tag tag)
          _ (&.with-type-env
              (tc.check inputT variantT))]
-        (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~@ values))) next)))
+        (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next)))
 
     _
     (&.throw Unrecognized-Pattern-Syntax (%code pattern))
diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
index 5d34387b4..ae72b47e4 100644
--- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux
+++ b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
@@ -71,7 +71,7 @@
 
     ## Tuple patterns can be exhaustive if there is exhaustiveness for all of
     ## their sub-patterns.
-    (^code ("lux case tuple" [(~@ subs)]))
+    (^code ("lux case tuple" [(~+ subs)]))
     (loop [subs subs]
       (case subs
         #.Nil
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
index 0f3cdcf6e..1463e7ec5 100644
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ b/new-luxc/source/luxc/lang/analysis/expression.lux
@@ -74,7 +74,7 @@
                    (<analyser> analyse tag value)
 
                    _
-                   (<analyser> analyse tag (` [(~@ values)]))))
+                   (<analyser> analyse tag (` [(~+ values)]))))
                ([#.Nat structureA.analyse-sum]
                 [#.Tag structureA.analyse-tagged-sum])
 
diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux
index 758acd681..a502a9d19 100644
--- a/new-luxc/source/luxc/lang/analysis/function.lux
+++ b/new-luxc/source/luxc/lang/analysis/function.lux
@@ -74,7 +74,7 @@
 
           (#.Function inputT outputT)
           (<| (:: @ map (function [[scope bodyA]]
-                          (` ("lux function" [(~@ (list/map code.int (variableL.environment scope)))]
+                          (` ("lux function" [(~+ (list/map code.int (variableL.environment scope)))]
                               (~ bodyA)))))
               &.with-scope
               ## Functions have access not only to their argument, but
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
index b003edfa7..ecdcd0bfd 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
@@ -20,6 +20,7 @@
                         [".A" type]))))
 
 (exception: #export Incorrect-Procedure-Arity)
+(exception: #export Invalid-Syntax)
 
 ## [Utils]
 (type: #export Proc
@@ -80,7 +81,7 @@
 
 ## [Analysers]
 ## "lux is" represents reference/pointer equality.
-(def: (lux-is proc)
+(def: (lux//is proc)
   (-> Text Proc)
   (function [analyse eval args]
     (do macro.Monad<Meta>
@@ -90,7 +91,7 @@
 
 ## "lux try" provides a simple way to interact with the host platform's
 ## error-handling facilities.
-(def: (lux-try proc)
+(def: (lux//try proc)
   (-> Text Proc)
   (function [analyse eval args]
     (case args
@@ -127,6 +128,22 @@
       _
       (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))
 
+(def: (lux//in-module proc)
+  (-> Text Proc)
+  (function [analyse eval argsC+]
+    (case argsC+
+      (^ (list [_ (#.Text module-name)] exprC))
+      (&.with-current-module module-name
+        (analyse exprC))
+      
+      _
+      (&.throw Invalid-Syntax (format "Procedure: " proc "\n"
+                                      "   Inputs:" (|> argsC+
+                                                       list.enumerate
+                                                       (list/map (function [[idx argC]]
+                                                                   (format "\n  " (%n idx) " " (%code argC))))
+                                                       (text.join-with "")) "\n")))))
+
 (do-template [<name> <analyser>]
   [(def: (<name> proc)
      (-> Text Proc)
@@ -158,13 +175,14 @@
 (def: lux-procs
   Bundle
   (|> (dict.new text.Hash<Text>)
-      (install "is" lux-is)
-      (install "try" lux-try)
+      (install "is" lux//is)
+      (install "try" lux//try)
       (install "function" lux//function)
       (install "case" lux//case)
       (install "check" lux//check)
       (install "coerce" lux//coerce)
-      (install "check type" lux//check//type)))
+      (install "check type" lux//check//type)
+      (install "in-module" lux//in-module)))
 
 (def: io-procs
   Bundle
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index fb521d02e..ce678837e 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -156,10 +156,9 @@
         ## blurring the line between what was wanted (the separation)
         ## and what was analysed.
         [tailT tailC]
-        (do @
-          [g!tail (macro.gensym "tail")]
+        (macro.with-gensyms [g!tail]
           (&.with-type tailT
-            (analyse (` ("lux case" [(~@ tailC)]
+            (analyse (` ("lux case" [(~+ tailC)]
                          (~ g!tail)
                          (~ g!tail))))))
         ))))
@@ -170,7 +169,7 @@
     [expectedT macro.expected-type]
     (&.with-stacked-errors
       (function [_] (Cannot-Analyse-Tuple (format "      Type: " (%type expectedT) "\n"
-                                                  "Expression: " (%code (` [(~@ membersC)])))))
+                                                  "Expression: " (%code (` [(~+ membersC)])))))
       (case expectedT
         (#.Product _)
         (analyse-typed-product analyse membersC)
@@ -219,7 +218,7 @@
 
               _
               (&.throw Invalid-Tuple-Type (format "      Type: " (%type expectedT) "\n"
-                                                  "Expression: " (%code (` [(~@ membersC)]))))))
+                                                  "Expression: " (%code (` [(~+ membersC)]))))))
 
           _
           (case (type.apply (list inputT) funT)
@@ -232,7 +231,7 @@
         
         _
         (&.throw Invalid-Tuple-Type (format "      Type: " (%type expectedT) "\n"
-                                            "Expression: " (%code (` [(~@ membersC)]))))
+                                            "Expression: " (%code (` [(~+ membersC)]))))
         ))))
 
 (def: #export (analyse-tagged-sum analyse tag valueC)
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
index ab4820b30..3e57de337 100644
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -16,7 +16,7 @@
 (def: (path' arity num-locals pattern)
   (-> ls.Arity Nat la.Pattern [Nat (List ls.Path)])
   (case pattern
-    (^code ("lux case tuple" [(~@ membersP)]))
+    (^code ("lux case tuple" [(~+ membersP)]))
     (case membersP
       #.Nil
       [num-locals
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index d3fbfcb58..b31a146a1 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -40,7 +40,7 @@
 (def: (function$ arity environment body)
   (-> ls.Arity (List Variable) ls.Synthesis ls.Synthesis)
   (` ("lux function" (~ (code.nat arity))
-      [(~@ (list/map code.int environment))]
+      [(~+ (list/map code.int environment))]
       (~ body))))
 
 (def: (variant$ tag last? valueS)
@@ -53,11 +53,11 @@
 
 (def: (procedure$ name argsS)
   (-> Text (List ls.Synthesis) ls.Synthesis)
-  (` ((~ (code.text name)) (~@ argsS))))
+  (` ((~ (code.text name)) (~+ argsS))))
 
 (def: (call$ funcS argsS)
   (-> ls.Synthesis (List ls.Synthesis) ls.Synthesis)
-  (` ("lux call" (~ funcS) (~@ argsS))))
+  (` ("lux call" (~ funcS) (~+ argsS))))
 
 (def: (synthesize-case arity num-locals synthesize inputA branchesA)
   (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis)
@@ -100,14 +100,14 @@
         funcS (synthesize funcA)
         argsS (list/map synthesize argsA)]
     (case funcS
-      (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~@ _env)] (~ _bodyS)))
+      (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~+ _env)] (~ _bodyS)))
               (and (n/= _arity (list.size argsS))
                    (not (loopS.contains-self-reference? _bodyS)))
               [(s.run _env (p.some s.int)) (#e.Success _env)])
-      (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~@ argsS)]
+      (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~+ argsS)]
           (~ (loopS.adjust _env num-locals _bodyS))))
 
-      (^code ("lux call" (~ funcS') (~@ argsS')))
+      (^code ("lux call" (~ funcS') (~+ argsS')))
       (call$ funcS' (list/compose argsS' argsS))
 
       _
@@ -122,7 +122,7 @@
          expressionA expressionA]
     (case expressionA
       (^code [(~ _left) (~ _right)])
-      (` [(~@ (list/map (recur arity resolver false num-locals)
+      (` [(~+ (list/map (recur arity resolver false num-locals)
                         (la.unfold-tuple expressionA)))])
 
       (^or (^code ("lux sum left" (~ _)))
@@ -143,7 +143,7 @@
       (^code ("lux case" (~ inputA) (~ [_ (#.Record branchesA)])))
       (synthesize-case arity num-locals (recur arity resolver false) inputA branchesA)
 
-      (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
+      (^multi (^code ("lux function" [(~+ scope)] (~ bodyA)))
               [(s.run scope (p.some s.int)) (#e.Success raw-env)])
       (let [function-arity (if direct?
                              (n/inc arity)
@@ -186,10 +186,10 @@
           bodyS
           (function$ +1 env (prepare-body function-arity +1 bodyS))))
 
-      (^code ("lux apply" (~@ _)))
+      (^code ("lux apply" (~+ _)))
       (synthesize-apply (recur arity resolver false num-locals) num-locals expressionA)
 
-      (^code ((~ [_ (#.Text name)]) (~@ args)))
+      (^code ((~ [_ (#.Text name)]) (~+ args)))
       (procedure$ name (list/map (recur arity resolver false num-locals) args))
 
       _
diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux
index 0510e2377..762032a59 100644
--- a/new-luxc/source/luxc/lang/synthesis/loop.lux
+++ b/new-luxc/source/luxc/lang/synthesis/loop.lux
@@ -96,7 +96,7 @@
                                    [_ (#.Form (list [_ (#.Int 0)]))]
                                    argsS))])
               (n/= arity (list.size argsS)))
-      (` ("lux recur" (~@ argsS)))
+      (` ("lux recur" (~+ argsS)))
 
       (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))])
       (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS))))
@@ -119,8 +119,8 @@
         (^code ((~ [_ (#.Nat tag)]) (~ last?) (~ valueS)))
         (` ((~ (code.nat tag)) (~ last?) (~ (recur valueS))))
         
-        (^code [(~@ members)])
-        (` [(~@ (list/map recur members))])
+        (^code [(~+ members)])
+        (` [(~+ (list/map recur members))])
 
         (^code ("lux case" (~ inputS) (~ pathS)))
         (` ("lux case" (~ (recur inputS))
@@ -142,9 +142,9 @@
                      _
                      pathS))))))
 
-        (^code ("lux function" (~ arity) [(~@ environment)] (~ bodyS)))
+        (^code ("lux function" (~ arity) [(~+ environment)] (~ bodyS)))
         (` ("lux function" (~ arity)
-            [(~@ (list/map (function [_var]
+            [(~+ (list/map (function [_var]
                              (case _var
                                (^ [_ (#.Form (list [_ (#.Int var)]))])
                                (` ((~ (code.int (resolve-captured var)))))
@@ -155,10 +155,10 @@
             (~ bodyS)))
 
         (^ [_ (#.Form (list& [_ (#.Text "lux call")] funcS argsS))])
-        (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS))))
+        (` ("lux call" (~ (recur funcS)) (~+ (list/map recur argsS))))
 
         (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))])
-        (` ("lux recur" (~@ (list/map recur argsS))))
+        (` ("lux recur" (~+ (list/map recur argsS))))
         
         (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ bodyS)))
         (` ("lux let" (~ (code.nat (n/+ offset register)))
@@ -172,7 +172,7 @@
 
         (^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat loop-offset)] [_ (#.Tuple initsS)] bodyS))])
         (` ("lux loop" (~ (code.nat (n/+ offset loop-offset)))
-            [(~@ (list/map recur initsS))]
+            [(~+ (list/map recur initsS))]
             (~ (recur bodyS))))
 
         (^ [_ (#.Form (list [_ (#.Int var)]))])
@@ -181,7 +181,7 @@
           (` ((~ (code.int (|> offset nat-to-int (i/+ var)))))))
 
         (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))])
-        (` ((~ (code.text procedure)) (~@ (list/map recur argsS))))
+        (` ((~ (code.text procedure)) (~+ (list/map recur argsS))))
 
         _
         exprS
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 07f1fe533..71bef93a2 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -72,7 +72,7 @@
 (def: #export (translate translate-module aliases code)
   (-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases))
   (case code
-    (^code ((~ [_ (#.Symbol macro-name)]) (~@ args)))
+    (^code ((~ [_ (#.Symbol macro-name)]) (~+ args)))
     (do macro.Monad<Meta>
       [?macro (&.with-error-tracking
                 (macro.find-macro macro-name))]
diff --git a/new-luxc/source/luxc/lang/translation/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
index c75ef0a19..4496de784 100644
--- a/new-luxc/source/luxc/lang/translation/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
@@ -44,7 +44,7 @@
     (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS)))
     (structureT.translate-variant translate tag last? valueS)
 
-    (^code [(~@ members)])
+    (^code [(~+ members)])
     (structureT.translate-tuple translate members)
 
     (^ [_ (#.Form (list [_ (#.Int var)]))])
@@ -61,14 +61,14 @@
     (^code ("lux case" (~ inputS) (~ pathPS)))
     (caseT.translate-case translate inputS pathPS)
 
-    (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~@ environment)] (~ bodyS)))
+    (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
             [(s.run environment (p.some s.int)) (#e.Success environment)])
     (functionT.translate-function translate environment arity bodyS)
 
-    (^code ("lux call" (~ functionS) (~@ argsS)))
+    (^code ("lux call" (~ functionS) (~+ argsS)))
     (functionT.translate-call translate functionS argsS)
 
-    (^code ((~ [_ (#.Text procedure)]) (~@ argsS)))
+    (^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
     (procedureT.translate-procedure translate procedure argsS)
 
     _
diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
index 41d9b91ab..336293dc4 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -47,7 +47,7 @@
   (Dict Text Proc))
 
 (syntax: (Vector [size s.nat] elemT)
-  (wrap (list (` [(~@ (list.repeat size elemT))]))))
+  (wrap (list (` [(~+ (list.repeat size elemT))]))))
 
 (type: #export Nullary (-> (Vector +0 $.Inst) $.Inst))
 (type: #export Unary   (-> (Vector +1 $.Inst) $.Inst))
@@ -91,13 +91,13 @@
                        (function [(~ g!name)]
                          (function [(~ g!translate) (~ g!inputs)]
                            (case (~ g!inputs)
-                             (^ (list (~@ g!input+)))
+                             (^ (list (~+ g!input+)))
                              (do macro.Monad<Meta>
-                               [(~@ (|> g!input+
+                               [(~+ (|> g!input+
                                         (list/map (function [g!input]
                                                     (list g!input (` ((~ g!translate) (~ g!input))))))
                                         list.concat))]
-                               ((~' wrap) ((~ g!proc) [(~@ g!input+)])))
+                               ((~' wrap) ((~ g!proc) [(~+ g!input+)])))
 
                              (~' _)
                              (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs))))))))))))))
diff --git a/new-luxc/source/luxc/lang/translation/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
index 9a78be78e..f7cdb524f 100644
--- a/new-luxc/source/luxc/lang/translation/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
@@ -24,7 +24,7 @@
   (-> (-> ls.Synthesis (Meta $.Inst)) (List ls.Synthesis) (Meta $.Inst))
   (do macro.Monad<Meta>
     [#let [size (list.size members)]
-     _ (&.assert Not-A-Tuple (%code (` [(~@ members)]))
+     _ (&.assert Not-A-Tuple (%code (` [(~+ members)]))
                  (n/>= +2 size))
      membersI (|> members
                   list.enumerate