- Refactored macro-expansion code.

- Added extra functionality to lux/compiler/default/phase/analysis.

3 files changed, 155 insertions, 116 deletions

diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 0a122bf3c..c69ff8eb2 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -1,5 +1,7 @@
 (.module:
   [lux (#- nat int rev)
+   [control
+    [monad (#+ do)]]
    [data
     ["." product]
     ["." error]
@@ -60,17 +62,6 @@
   (#Apply Analysis Analysis)
   (#Extension (Extension Analysis)))
 
-(do-template [<special> <general>]
-  [(type: #export <special>
-     (<general> .Lux Code Analysis))]
-
-  [State+    extension.State]
-  [Operation extension.Operation]
-  [Phase     extension.Phase]
-  [Handler   extension.Handler]
-  [Bundle    extension.Bundle]
-  )
-
 (type: #export Branch
   (Branch' Analysis))
 
@@ -178,6 +169,81 @@
 (template: #export (pattern/bind register)
   (#..Bind register))
 
+(def: #export (%analysis analysis)
+  (Format Analysis)
+  (case analysis
+    (#Primitive primitive)
+    (case primitive
+      #Unit
+      "[]"
+
+      (^template [<tag> <format>]
+        (<tag> value)
+        (<format> value))
+      ([#Bit %b]
+       [#Nat %n]
+       [#Int %i]
+       [#Rev %r]
+       [#Frac %f]
+       [#Text %t]))
+    
+    (#Structure structure)
+    (case structure
+      (#Variant [lefts right? value])
+      (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")")
+      
+      (#Tuple members)
+      (|> members
+          (list/map %analysis)
+          (text.join-with " ")
+          (text.enclose ["[" "]"])))
+    
+    (#Reference reference)
+    (case reference
+      (#reference.Variable variable)
+      (reference.%variable variable)
+      
+      (#reference.Constant constant)
+      (%name constant))
+    
+    (#Case analysis match)
+    "{?}"
+    
+    (#Function environment body)
+    (|> (%analysis body)
+        (format " ")
+        (format (|> environment
+                    (list/map reference.%variable)
+                    (text.join-with " ")
+                    (text.enclose ["[" "]"])))
+        (text.enclose ["(" ")"]))
+    
+    (#Apply _)
+    (|> analysis
+        ..application
+        #.Cons
+        (list/map %analysis)
+        (text.join-with " ")
+        (text.enclose ["(" ")"]))
+    
+    (#Extension name parameters)
+    (|> parameters
+        (list/map %analysis)
+        (text.join-with " ")
+        (format (%t name) " ")
+        (text.enclose ["(" ")"]))))
+
+(do-template [<special> <general>]
+  [(type: #export <special>
+     (<general> .Lux Code Analysis))]
+
+  [State+    extension.State]
+  [Operation extension.Operation]
+  [Phase     extension.Phase]
+  [Handler   extension.Handler]
+  [Bundle    extension.Bundle]
+  )
+
 (def: #export (with-source-code source action)
   (All [a] (-> Source (Operation a) (Operation a)))
   (function (_ [bundle state])
@@ -249,66 +315,35 @@
   [set-cursor         Cursor #.cursor         value]
   )
 
-(def: #export (%analysis analysis)
-  (Format Analysis)
-  (case analysis
-    (#Primitive primitive)
-    (case primitive
-      #Unit
-      "[]"
-
-      (^template [<tag> <format>]
-        (<tag> value)
-        (<format> value))
-      ([#Bit %b]
-       [#Nat %n]
-       [#Int %i]
-       [#Rev %r]
-       [#Frac %f]
-       [#Text %t]))
-    
-    (#Structure structure)
-    (case structure
-      (#Variant [lefts right? value])
-      (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")")
-      
-      (#Tuple members)
-      (|> members
-          (list/map %analysis)
-          (text.join-with " ")
-          (text.enclose ["[" "]"])))
-    
-    (#Reference reference)
-    (case reference
-      (#reference.Variable variable)
-      (reference.%variable variable)
-      
-      (#reference.Constant constant)
-      (%name constant))
-    
-    (#Case analysis match)
-    "{?}"
-    
-    (#Function environment body)
-    (|> (%analysis body)
-        (format " ")
-        (format (|> environment
-                    (list/map reference.%variable)
-                    (text.join-with " ")
-                    (text.enclose ["[" "]"])))
-        (text.enclose ["(" ")"]))
-    
-    (#Apply _)
-    (|> analysis
-        ..application
-        #.Cons
-        (list/map %analysis)
-        (text.join-with " ")
-        (text.enclose ["(" ")"]))
-    
-    (#Extension name parameters)
-    (|> parameters
-        (list/map %analysis)
-        (text.join-with " ")
-        (format (%t name) " ")
-        (text.enclose ["(" ")"]))))
+(def: #export (cursor file)
+  (-> Text Cursor)
+  [file 1 0])
+
+(def: #export (source file code)
+  (-> Text Text Source)
+  [(cursor file) 0 code])
+
+(def: dummy-source
+  Source
+  [.dummy-cursor 0 ""])
+
+(def: type-context
+  Type-Context
+  {#.ex-counter 0
+   #.var-counter 0
+   #.var-bindings (list)})
+
+(def: #export (state info host)
+  (-> Info Any Lux)
+  {#.info            info
+   #.source          ..dummy-source
+   #.cursor          .dummy-cursor
+   #.current-module  #.None
+   #.modules         (list)
+   #.scopes          (list)
+   #.type-context    ..type-context
+   #.expected        #.None
+   #.seed            0
+   #.scope-type-vars (list)
+   #.extensions      []
+   #.host            host})
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
index 317f86a6f..1da6520a5 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
@@ -5,10 +5,8 @@
     ["ex" exception (#+ exception:)]]
    [data
     ["." error]
-    ["." text
-     format]
-    [collection
-     [list ("list/." Functor<List>)]]]
+    [text
+     format]]
    ["." macro]]
   ["." // (#+ Analysis Operation Phase)
    ["." type]
@@ -23,33 +21,9 @@
     [//
      ["." reference]]]])
 
-(exception: #export (macro-expansion-failed {macro Name} {inputs (List Code)} {error Text})
-  (ex.report ["Macro" (%name macro)]
-             ["Inputs" (|> inputs
-                           (list/map (|>> %code (format text.new-line text.tab)))
-                           (text.join-with ""))]
-             ["Error" error]))
-
-(exception: #export (macro-call-must-have-single-expansion {macro Name} {inputs (List Code)})
-  (ex.report ["Macro" (%name macro)]
-             ["Inputs" (|> inputs
-                           (list/map (|>> %code (format text.new-line text.tab)))
-                           (text.join-with ""))]))
-
 (exception: #export (unrecognized-syntax {code Code})
   (ex.report ["Code" (%code code)]))
 
-(def: #export (expand-macro name macro inputs)
-  (-> Name Macro (List Code) (Operation (List Code)))
-  (extension.lift
-   (function (_ state)
-     (case (//macro.expand macro inputs state)
-       (#error.Error error)
-       ((///.throw macro-expansion-failed [name inputs error]) state)
-
-       output
-       output))))
-
 (def: #export (compile code)
   Phase
   (do ///.Monad<Operation>
@@ -121,13 +95,8 @@
                 (case ?macro
                   (#.Some macro)
                   (do @
-                    [expansion (expand-macro def-name macro argsC+)]
-                    (case expansion
-                      (^ (list single))
-                      (compile single)
-
-                      _
-                      (///.throw macro-call-must-have-single-expansion [def-name argsC+])))
+                    [expansion (extension.lift (//macro.expand-one def-name macro argsC+))]
+                    (compile expansion))
 
                   _
                   (function.apply compile functionT functionA argsC+)))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/macro.lux b/stdlib/source/lux/compiler/default/phase/analysis/macro.lux
index 7aa9a01a4..af12c747d 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/macro.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/macro.lux
@@ -1,12 +1,31 @@
 (.module:
   [lux #*
    [control
-    [monad (#+ do)]]
+    [monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
    [data
     ["." error (#+ Error)]
+    ["." text
+     format]
     [collection
-     [array (#+ Array)]]]
-   ["." host (#+ import:)]])
+     [array (#+ Array)]
+     [list ("list/." Functor<List>)]]]
+   ["." macro]
+   ["." host (#+ import:)]]
+  ["." ///])
+
+(exception: #export (expansion-failed {macro Name} {inputs (List Code)} {error Text})
+  (ex.report ["Macro" (%name macro)]
+             ["Inputs" (|> inputs
+                           (list/map (|>> %code (format text.new-line text.tab)))
+                           (text.join-with ""))]
+             ["Error" error]))
+
+(exception: #export (must-have-single-expansion {macro Name} {inputs (List Code)})
+  (ex.report ["Macro" (%name macro)]
+             ["Inputs" (|> inputs
+                           (list/map (|>> %code (format text.new-line text.tab)))
+                           (text.join-with ""))]))
 
 (import: java/lang/reflect/Method
   (invoke [Object (Array Object)] #try Object))
@@ -27,8 +46,8 @@
       (host.array-write 0 _object-class)
       (host.array-write 1 _object-class)))
 
-(def: #export (expand macro inputs)
-  (-> Macro (List Code) (Meta (List Code)))
+(def: #export (expand name macro inputs)
+  (-> Name Macro (List Code) (Meta (List Code)))
   (function (_ state)
     (do error.Monad<Error>
       [apply-method (|> macro
@@ -40,5 +59,21 @@
                                   (host.array-write 0 (:coerce Object inputs))
                                   (host.array-write 1 (:coerce Object state)))
                               apply-method)]
-      (:coerce (Error [Lux (List Code)])
-               output))))
+      (case (:coerce (Error [Lux (List Code)])
+                     output)
+        (#error.Success output)
+        (#error.Success output)
+        
+        (#error.Error error)
+        ((///.throw expansion-failed [name inputs error]) state)))))
+
+(def: #export (expand-one name macro inputs)
+  (-> Name Macro (List Code) (Meta Code))
+  (do macro.Monad<Meta>
+    [expansion (expand name macro inputs)]
+    (case expansion
+      (^ (list single))
+      (wrap single)
+
+      _
+      (///.throw must-have-single-expansion [name inputs]))))