1 files changed, 121 insertions, 0 deletions
diff --git a/stdlib/source/lux/language/compiler/analysis/expression.lux b/stdlib/source/lux/language/compiler/analysis/expression.lux
new file mode 100644
index 000000000..2ef2cae5b
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/expression.lux
@@ -0,0 +1,121 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [product]
+             text/format)
+       [macro])
+  [//// #+ Eval]
+  ## (//// [".L" macro]
+  ##       [".L" extension])
+  [///]
+  [// #+ Analysis Operation Compiler]
+  [//type]
+  [//primitive]
+  [//structure]
+  [//reference])
+
+(exception: #export (macro-expansion-failed {message Text})
+  message)
+
+(do-template [<name>]
+  [(exception: #export (<name> {code Code})
+     (%code code))]
+
+  [macro-call-must-have-single-expansion]
+  [unrecognized-syntax]
+  )
+
+(def: #export (analyser eval)
+  (-> Eval Compiler)
+  (function (compile code)
+    (do ///.Monad<Operation>
+      [expectedT macro.expected-type]
+      (let [[cursor code'] code]
+        ## The cursor must be set in the compiler for the sake
+        ## of having useful error messages.
+        (//.with-cursor cursor
+          (case code'
+            (^template [<tag> <analyser>]
+              (<tag> value)
+              (<analyser> value))
+            ([#.Bool //primitive.bool]
+             [#.Nat  //primitive.nat]
+             [#.Int  //primitive.int]
+             [#.Rev  //primitive.rev]
+             [#.Frac //primitive.frac]
+             [#.Text //primitive.text])
+
+            (^template [<tag> <analyser>]
+              (^ (#.Form (list& [_ (<tag> tag)]
+                                values)))
+              (case values
+                (#.Cons value #.Nil)
+                (<analyser> compile tag value)
+
+                _
+                (<analyser> compile tag (` [(~+ values)]))))
+            ([#.Nat //structure.sum]
+             [#.Tag //structure.tagged-sum])
+
+            (#.Tag tag)
+            (//structure.tagged-sum compile tag (' []))
+
+            (^ (#.Tuple (list)))
+            //primitive.unit
+
+            (^ (#.Tuple (list singleton)))
+            (compile singleton)
+
+            (^ (#.Tuple elems))
+            (//structure.product compile elems)
+
+            (^ (#.Record pairs))
+            (//structure.record compile pairs)
+
+            (#.Symbol reference)
+            (//reference.reference reference)
+
+            (^ (#.Form (list& [_ (#.Text extension-name)] extension-args)))
+            (undefined)
+            ## (do ///.Monad<Operation>
+            ##   [extension (extensionL.find-analysis extension-name)]
+            ##   (extension compile eval extension-args))
+
+            ## (^ (#.Form (list& func args)))
+            ## (do ///.Monad<Operation>
+            ##   [[funcT funcA] (//type.with-inference
+            ##                    (compile func))]
+            ##   (case funcA
+            ##     [_ (#.Symbol def-name)]
+            ##     (do @
+            ##       [?macro (///.with-error-tracking
+            ##                 (macro.find-macro def-name))]
+            ##       (case ?macro
+            ##         (#.Some macro)
+            ##         (do @
+            ##           [expansion (: (Operation (List Code))
+            ##                         (function (_ compiler)
+            ##                           (case (macroL.expand macro args compiler)
+            ##                             (#e.Error error)
+            ##                             ((///.throw macro-expansion-failed error) compiler)
+
+            ##                             output
+            ##                             output)))]
+            ##           (case expansion
+            ##             (^ (list single))
+            ##             (compile single)
+
+            ##             _
+            ##             (///.throw macro-call-must-have-single-expansion code)))
+
+            ##         _
+            ##         (functionA.apply compile funcT funcA args)))
+
+            ##     _
+            ##     (functionA.apply compile funcT funcA args)))
+
+            _
+            (///.throw unrecognized-syntax code)
+            ))))))