From aa3dcb411db1bfbf41ca59c334c6c792b9e40d0c Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 31 May 2017 21:35:39 -0400
Subject: - Implemented some synthesis algorithms and tests for primitives,
 structures, procedures and function application. - Some refactoring.

---
 new-luxc/source/luxc/lang/analysis.lux  | 61 ++++++++++++++++++++++++++++++++-
 new-luxc/source/luxc/lang/synthesis.lux | 30 +++++++++++++---
 2 files changed, 85 insertions(+), 6 deletions(-)

(limited to 'new-luxc/source/luxc/lang')

diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index b96bd9ba2..2e122a526 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -1,5 +1,7 @@
 (;module:
-  lux)
+  lux
+  (lux [function]
+       (data (coll [list "L/" Fold<List>]))))
 
 (type: #export #rec Pattern
   (#BindP Nat)
@@ -30,3 +32,60 @@
   (#Procedure Text (List Analysis))
   (#Relative Ref)
   (#Absolute Ident))
+
+## Variants get analysed as binary sum types for the sake of semantic
+## simplicity.
+## This is because you can encode a variant of any size using just
+## binary sums by nesting them.
+
+(do-template [<name> <side>]
+  [(def: (<name> inner)
+     (-> Analysis Analysis)
+     (#Sum (<side> inner)))]
+
+  [sum-left  #;Left]
+  [sum-right #;Right])
+
+(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)
+                                  (#Relative (#;Local 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
+## through nesting.
+
+(def: #export (product members)
+  (-> (List Analysis) Analysis)
+  (case members
+    #;Nil
+    #Unit
+
+    (#;Cons singleton #;Nil)
+    singleton
+
+    (#;Cons left right)
+    (#Product left (product right))))
+
+## Function application gets analysed into single-argument
+## applications, since every other kind of application can be encoded
+## into a finite series of single-argument applications.
+
+(def: #export (apply args func)
+  (-> (List Analysis) Analysis Analysis)
+  (L/fold (function [arg func] (#Apply arg func))
+          func
+          args))
diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux
index 491891600..5fd6a3a81 100644
--- a/new-luxc/source/luxc/lang/synthesis.lux
+++ b/new-luxc/source/luxc/lang/synthesis.lux
@@ -1,6 +1,21 @@
 (;module:
-  lux
-  (.. ["lp" pattern]))
+  lux)
+
+(type: #export (Path' s)
+  #PopP
+  (#BindP Nat)
+  (#BoolP Bool)
+  (#NatP Nat)
+  (#IntP Int)
+  (#DegP Deg)
+  (#RealP Real)
+  (#CharP Char)
+  (#TextP Text)
+  (#VariantP (Either Nat Nat))
+  (#TupleP (Either Nat Nat))
+  (#AltP (Path' s) (Path' s))
+  (#SeqP (Path' s) (Path' s))
+  (#ExecP s))
 
 (type: #export #rec Synthesis
   #Unit
@@ -13,10 +28,15 @@
   (#Text Text)
   (#Variant Nat Bool Synthesis)
   (#Tuple (List Synthesis))
-  (#Case (List [lp;Pattern Synthesis]))
+  (#Case Synthesis (Path' Synthesis))
   (#Function Nat Scope Synthesis)
   (#Call Synthesis (List Synthesis))
   (#Recur Nat (List Synthesis))
   (#Procedure Text (List Synthesis))
-  (#Relative Ref)
-  (#Absolute Ident))
+  (#Relative Int)
+  (#Absolute Ident)
+  (#Let Nat Synthesis Synthesis)
+  (#If Synthesis Synthesis Synthesis)
+  (#Loop Nat (List Synthesis) Synthesis))
+
+(type: #export Path (Path' Synthesis))
-- 
cgit v1.2.3