- Migrated the format of analysis nodes from a custom data-type, to just Code nodes.

3 files changed, 118 insertions, 51 deletions

diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index 7a4ae37ac..03e4c867f 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -1,35 +1,13 @@
 (;module:
   lux
   (lux [function]
-       (data (coll [list "L/" Fold<List>]))))
-
-(type: #export #rec Pattern
-  (#BoolP Bool)
-  (#NatP Nat)
-  (#IntP Int)
-  (#DegP Deg)
-  (#FracP Frac)
-  (#TextP Text)
-  (#TupleP (List Pattern))
-  (#VariantP Nat Nat Pattern)
-  (#BindP Nat))
-
-(type: #export #rec Analysis
-  #Unit
-  (#Bool Bool)
-  (#Nat Nat)
-  (#Int Int)
-  (#Deg Deg)
-  (#Frac Frac)
-  (#Text Text)
-  (#Sum (Either Analysis Analysis))
-  (#Product Analysis Analysis)
-  (#Case Analysis (List [Pattern Analysis]))
-  (#Function Scope Analysis)
-  (#Apply Analysis Analysis)
-  (#Procedure Text (List Analysis))
-  (#Variable Ref)
-  (#Definition Ident))
+       (data (coll [list "list/" Fold<List>]))
+       (meta [code]))
+  (luxc (lang [";L" variable #+ Variable])))
+
+(type: #export Pattern Code)
+
+(type: #export Analysis Code)
 
 ## Variants get analysed as binary sum types for the sake of semantic
 ## simplicity.
@@ -39,28 +17,34 @@
 (do-template [<name> <side>]
   [(def: (<name> inner)
      (-> Analysis Analysis)
-     (#Sum (<side> inner)))]
+     (` (<side> (~ inner))))]
+
+  [sum-left  "lux sum left"]
+  [sum-right "lux sum right"])
 
-  [sum-left  #;Left]
-  [sum-right #;Right])
+(def: (local-variable idx)
+  (-> Nat Int)
+  (nat-to-int idx))
 
 (def: #export (sum tag size temp value)
   (-> Nat Nat Nat Analysis Analysis)
   (if (n.= (n.dec size) tag)
     (if (n.= +1 tag)
       (sum-right value)
-      (L/fold (function;const sum-left)
-              (sum-right value)
-              (list;n.range +0 (n.- +2 tag))))
-    (L/fold (function;const sum-left)
-            (case value
-              (#Sum _)
-              (#Case value (list [(#BindP temp)
-                                  (#Variable (#;Local temp))]))
-
-              _
-              value)
-            (list;n.range +0 tag))))
+      (list/fold (function;const sum-left)
+                 (sum-right value)
+                 (list;n.range +0 (n.- +2 tag))))
+    (list/fold (function;const sum-left)
+               (case value
+                 (^or (^code ("lux sum left" (~ inner)))
+                      (^code ("lux sum right" (~ inner))))
+                 (` ("lux case" (~ value)
+                     {("lux case bind" (~ (code;nat temp)))
+                      ((~ (code;int (local-variable temp))))}))
+
+                 _
+                 value)
+               (list;n.range +0 tag))))
 
 ## Tuples get analysed into binary products for the sake of semantic
 ## simplicity, since products/pairs can encode tuples of any length
@@ -70,13 +54,13 @@
   (-> (List Analysis) Analysis)
   (case members
     #;Nil
-    #Unit
+    (` [])
 
     (#;Cons singleton #;Nil)
     singleton
 
     (#;Cons left right)
-    (#Product left (product right))))
+    (` [(~ left) (~ (product right))])))
 
 ## Function application gets analysed into single-argument
 ## applications, since every other kind of application can be encoded
@@ -84,6 +68,44 @@
 
 (def: #export (apply args func)
   (-> (List Analysis) Analysis Analysis)
-  (L/fold (function [arg func] (#Apply arg func))
-          func
-          args))
+  (list/fold (function [arg func]
+               (` ("lux apply" (~ arg) (~ func))))
+             func
+             args))
+
+(def: #export (procedure name args)
+  (-> Text (List Analysis) Analysis)
+  (` ((~ (code;text name)) (~@ args))))
+
+(def: #export (var idx)
+  (-> Variable Analysis)
+  (` ((~ (code;int idx)))))
+
+(def: #export (unfold-tuple analysis)
+  (-> Analysis (List Analysis))
+  (case analysis
+    (^code [(~ left) (~ right)])
+    (#;Cons left (unfold-tuple right))
+
+    _
+    (list analysis)))
+
+(def: #export (unfold-variant analysis)
+  (-> Analysis (Maybe [Nat Bool Analysis]))
+  (loop [so-far +0
+         variantA analysis]
+    (case variantA
+      (^code ("lux sum left" (~ valueA)))
+      (case valueA
+        (^or (^code ("lux sum left" (~ _)))
+             (^code ("lux sum right" (~ _))))
+        (recur (n.inc so-far) valueA)
+
+        _
+        (#;Some [so-far false valueA]))
+      
+      (^code ("lux sum right" (~ valueA)))
+      (#;Some [(n.inc so-far) true valueA])
+
+      _
+      #;None)))
diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux
index 96053edc0..3207c41b4 100644
--- a/new-luxc/source/luxc/lang/synthesis.lux
+++ b/new-luxc/source/luxc/lang/synthesis.lux
@@ -2,8 +2,6 @@
   lux)
 
 (def: #export Arity Nat)
-(def: #export Register Nat)
-(def: #export Variable Int)
 
 (type: #export Synthesis Code)
 
diff --git a/new-luxc/source/luxc/lang/variable.lux b/new-luxc/source/luxc/lang/variable.lux
new file mode 100644
index 000000000..c04269e63
--- /dev/null
+++ b/new-luxc/source/luxc/lang/variable.lux
@@ -0,0 +1,47 @@
+(;module:
+  lux
+  (lux (data (coll [list "list/" Functor<List>]))))
+
+(def: #export Variable Int)
+(def: #export Register Nat)
+
+(def: #export (captured register)
+  (-> Nat Variable)
+  (|> register n.inc nat-to-int (i.* -1)))
+
+(def: #export (local register)
+  (-> Nat Variable)
+  (nat-to-int register))
+
+(def: #export (local-register variable)
+  (-> Variable Register)
+  (int-to-nat variable))
+
+(def: #export (captured-register variable)
+  (-> Variable Register)
+  (|> variable (i.* -1) int-to-nat n.dec))
+
+(do-template [<name> <comp>]
+  [(def: #export (<name> var)
+     (-> Variable Bool)
+     (<comp> 0 var))]
+
+  [self?     i.=]
+  [local?    i.>]
+  [captured? i.<]
+  )
+
+(def: #export (from-ref ref)
+  (-> Ref Variable)
+  (case ref
+    (#;Local register)
+    (local register)
+    
+    (#;Captured register)
+    (captured register)))
+
+(def: #export (environment scope)
+  (-> Scope (List Variable))
+  (|> scope
+      (get@ [#;captured #;mappings])
+      (list/map (function [[_ [_ ref]]] (from-ref ref)))))