1 files changed, 264 insertions, 0 deletions
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux
new file mode 100644
index 000000000..8deb48ba8
--- /dev/null
+++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux
@@ -0,0 +1,264 @@
+(.module:
+  [lux (#- i64 Scope)
+   [control [monad (#+ do)]]
+   [data
+    [error (#+ Error)]
+    [collection
+     ["dict" dictionary (#+ Dictionary)]]]]
+  ["." //
+   ["." analysis (#+ Environment Arity Analysis)]
+   ["." extension (#+ Extension)]
+   [//
+    ["." reference (#+ Register Variable Reference)]]])
+
+(type: #export Resolver (Dictionary Variable Variable))
+
+(type: #export State
+  {#scope-arity Arity
+   #resolver Resolver
+   #direct? Bit
+   #locals Nat})
+
+(def: #export fresh-resolver
+  Resolver
+  (dict.new reference.Hash<Variable>))
+
+(def: #export init
+  State
+  {#scope-arity +0
+   #resolver fresh-resolver
+   #direct? #0
+   #locals +0})
+
+(type: #export Primitive
+  (#Bit Bit)
+  (#I64 I64)
+  (#F64 Frac)
+  (#Text Text))
+
+(type: #export (Structure a)
+  (#Variant (analysis.Variant a))
+  (#Tuple (analysis.Tuple a)))
+
+(type: #export Side
+  (Either Nat Nat))
+
+(type: #export Member
+  (Either Nat Nat))
+
+(type: #export Access
+  (#Side Side)
+  (#Member Member))
+
+(type: #export (Path' s)
+  #Pop
+  (#Test Primitive)
+  (#Access Access)
+  (#Bind Register)
+  (#Alt (Path' s) (Path' s))
+  (#Seq (Path' s) (Path' s))
+  (#Then s))
+
+(type: #export (Abstraction' s)
+  {#environment Environment
+   #arity Arity
+   #body s})
+
+(type: #export (Apply' s)
+  {#function s
+   #arguments (List s)})
+
+(type: #export (Branch s)
+  (#Let s Register s)
+  (#If s s s)
+  (#Case s (Path' s)))
+
+(type: #export (Scope s)
+  {#start Register
+   #inits (List s)
+   #iteration s})
+
+(type: #export (Loop s)
+  (#Scope (Scope s))
+  (#Recur (List s)))
+
+(type: #export (Function s)
+  (#Abstraction (Abstraction' s))
+  (#Apply s (List s)))
+
+(type: #export (Control s)
+  (#Branch (Branch s))
+  (#Loop (Loop s))
+  (#Function (Function s)))
+
+(type: #export #rec Synthesis
+  (#Primitive Primitive)
+  (#Structure (Structure Synthesis))
+  (#Reference Reference)
+  (#Control (Control Synthesis))
+  (#Extension (Extension Synthesis)))
+
+(type: #export Operation
+  (extension.Operation ..State Analysis Synthesis))
+
+(type: #export Phase
+  (extension.Phase ..State Analysis Synthesis))
+
+(type: #export Path
+  (Path' Synthesis))
+
+(def: #export path/pop
+  Path
+  #Pop)
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (#..Test (<tag> content)))]
+
+  [path/bit  #..Bit]
+  [path/i64  #..I64]
+  [path/f64  #..F64]
+  [path/text #..Text]
+  )
+
+(do-template [<name> <kind>]
+  [(template: #export (<name> content)
+     (.<| #..Access
+          <kind>
+          content))]
+
+  [path/side   #..Side]
+  [path/member #..Member]
+  )
+
+(do-template [<name> <kind> <side>]
+  [(template: #export (<name> content)
+     (.<| #..Access
+          <kind>
+          <side>
+          content))]
+
+  [side/left    #..Side   #.Left]
+  [side/right   #..Side   #.Right]
+  [member/left  #..Member #.Left]
+  [member/right #..Member #.Right]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (<tag> content))]
+
+  [path/alt  #..Alt]
+  [path/seq  #..Seq]
+  [path/then #..Then]
+  )
+
+(type: #export Abstraction
+  (Abstraction' Synthesis))
+
+(type: #export Apply
+  (Apply' Synthesis))
+
+(def: #export unit Text "")
+
+(do-template [<name> <value>]
+  [(def: #export <name>
+     (All [a] (-> (Operation a) (Operation a)))
+     (extension.temporary (set@ #direct? <value>)))]
+
+  [indirectly #0]
+  [directly   #1]
+  )
+
+(do-template [<name> <type> <tag>]
+  [(def: #export (<name> value)
+     (-> <type> (All [a] (-> (Operation a) (Operation a))))
+     (extension.temporary (set@ <tag> value)))]
+
+  [with-scope-arity Arity    #scope-arity]
+  [with-resolver    Resolver #resolver]
+  [with-locals      Nat      #locals]
+  )
+
+(def: #export (with-abstraction arity resolver)
+  (-> Arity Resolver
+      (All [a] (-> (Operation a) (Operation a))))
+  (extension.with-state {#scope-arity arity
+                         #resolver resolver
+                         #direct? #1
+                         #locals arity}))
+
+(do-template [<name> <tag> <type>]
+  [(def: #export <name>
+     (Operation <type>)
+     (extension.read (get@ <tag>)))]
+
+  [scope-arity #scope-arity Arity]
+  [resolver    #resolver    Resolver]
+  [direct?     #direct?     Bit]
+  [locals      #locals      Nat]
+  )
+
+(def: #export with-new-local
+  (All [a] (-> (Operation a) (Operation a)))
+  (<<| (do //.Monad<Operation>
+         [locals ..locals])
+       (..with-locals (inc locals))))
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (#..Primitive (<tag> content)))]
+
+  [bit  #..Bit]
+  [i64  #..I64]
+  [f64  #..F64]
+  [text #..Text]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (<| #..Structure
+         <tag>
+         content))]
+
+  [variant #..Variant]
+  [tuple   #..Tuple]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Reference
+          <tag>
+          content))]
+
+  [variable/local   reference.local]
+  [variable/foreign reference.foreign]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Reference
+          <tag>
+          content))]
+
+  [variable reference.variable]
+  [constant reference.constant]
+  )
+
+(do-template [<name> <family> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Control
+          <family>
+          <tag>
+          content))]
+
+  [branch/case          #..Branch   #..Case]
+  [branch/let           #..Branch   #..Let]
+  [branch/if            #..Branch   #..If]
+
+  [loop/recur           #..Loop     #..Recur]
+  [loop/scope           #..Loop     #..Scope]
+
+  [function/abstraction #..Function #..Abstraction]
+  [function/apply       #..Function #..Apply]
+  )