- WIP: Migrated synthesis to stdlib.

5 files changed, 378 insertions, 1 deletions

diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux
index 381a40b79..1194351e5 100644
--- a/stdlib/test/test/lux/control/state.lux
+++ b/stdlib/test/test/lux/control/state.lux
@@ -83,7 +83,7 @@
         (let [(^open "io/") io.Monad<IO>]
           (test "Can add state functionality to any monad."
                 (|> (: (&.State' io.IO Nat Nat)
-                       (do (&.StateT io.Monad<IO>)
+                       (do (&.Monad<State'> io.Monad<IO>)
                          [a (&.lift io.Monad<IO> (io/wrap left))
                           b (wrap right)]
                          (wrap (n/+ a b))))
diff --git a/stdlib/test/test/lux/lang/synthesis/case.lux b/stdlib/test/test/lux/lang/synthesis/case.lux
new file mode 100644
index 000000000..3ae62badc
--- /dev/null
+++ b/stdlib/test/test/lux/lang/synthesis/case.lux
@@ -0,0 +1,72 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (macro [code])
+       ["r" math/random "r/" Monad<Random>]
+       test)
+  (luxc (lang ["la" analysis]
+              ["//" synthesis #+ Synthesis]
+              (synthesis [".S" expression])
+              [".L" extension]
+              [".L" variable #+ Variable]))
+  (/// common))
+
+(context: "Dummy variables."
+  (<| (times +100)
+      (do @
+        [maskedA gen-primitive
+         temp (|> r.nat (:: @ map (n/% +100)))
+         #let [maskA (` ("lux case" (~ maskedA)
+                         {("lux case bind" (~ (code.nat temp)))
+                          (~ (la.var (variableL.local temp)))}))]]
+        (test "Dummy variables created to mask expressions get eliminated during synthesis."
+              (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
+                                                   maskA))
+                  (corresponds? maskedA))))))
+
+(context: "Let expressions."
+  (<| (times +100)
+      (do @
+        [registerA r.nat
+         inputA gen-primitive
+         outputA gen-primitive
+         #let [letA (` ("lux case" (~ inputA)
+                        {("lux case bind" (~ (code.nat registerA)))
+                         (~ outputA)}))]]
+        (test "Can detect and reify simple 'let' expressions."
+              (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
+                                                   letA))
+                  (case> (^ [_ (#.Form (list [_ (#.Text "lux let")] [_ (#.Nat registerS)] inputS outputS))])
+                         (and (n/= registerA registerS)
+                              (corresponds? inputA inputS)
+                              (corresponds? outputA outputS))
+
+                         _
+                         false))))))
+
+(context: "If expressions."
+  (<| (times +100)
+      (do @
+        [then|else r.bool
+         inputA gen-primitive
+         thenA gen-primitive
+         elseA gen-primitive
+         #let [ifA (if then|else
+                     (` ("lux case" (~ inputA)
+                         {true (~ thenA)
+                          false (~ elseA)}))
+                     (` ("lux case" (~ inputA)
+                         {false (~ elseA)
+                          true (~ thenA)})))]]
+        (test "Can detect and reify simple 'if' expressions."
+              (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
+                                                   ifA))
+                  (case> (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))])
+                         (and (corresponds? inputA inputS)
+                              (corresponds? thenA thenS)
+                              (corresponds? elseA elseS))
+
+                         _
+                         false))))))
diff --git a/stdlib/test/test/lux/lang/synthesis/function.lux b/stdlib/test/test/lux/lang/synthesis/function.lux
new file mode 100644
index 000000000..c469d8665
--- /dev/null
+++ b/stdlib/test/test/lux/lang/synthesis/function.lux
@@ -0,0 +1,161 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [product]
+             [maybe]
+             [error]
+             [number]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]
+                   (dictionary ["dict" unordered #+ Dict])
+                   (set ["set" unordered])))
+       (lang [".L" analysis #+ Variable Analysis "variable/" Eq<Variable>]
+             ["//" synthesis #+ Arity Synthesis]
+             (synthesis [".S" expression])
+             [".L" extension])
+       ["r" math/random]
+       test)
+  [//primitive])
+
+(def: constant-function
+  (r.Random [Arity Analysis Analysis])
+  (r.rec
+   (function (_ constant-function)
+     (do r.Monad<Random>
+       [function? r.bool]
+       (if function?
+         (do @
+           [[arity bodyA predictionA] constant-function]
+           (wrap [(inc arity)
+                  (#analysisL.Function (list) bodyA)
+                  predictionA]))
+         (do @
+           [predictionA //primitive.primitive]
+           (wrap [+0 predictionA predictionA])))))))
+
+(def: (pick scope-size)
+  (-> Nat (r.Random Nat))
+  (|> r.nat (:: r.Monad<Random> map (n/% scope-size))))
+
+(def: function-with-environment
+  (r.Random [Arity Analysis Variable])
+  (do r.Monad<Random>
+    [num-locals (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10))))
+     #let [indices (list.n/range +0 (dec num-locals))
+           absolute-env (list/map (|>> #analysisL.Local) indices)
+           relative-env (list/map (|>> #analysisL.Foreign) indices)]
+     [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable])
+                                  (loop [arity +1
+                                         global-env relative-env]
+                                    (let [env-size (list.size global-env)
+                                          resolver (list/fold (function (_ [idx var] resolver)
+                                                                (dict.put idx var resolver))
+                                                              (: (Dict Nat Variable)
+                                                                 (dict.new number.Hash<Nat>))
+                                                              (list.zip2 (list.n/range +0 (dec env-size))
+                                                                         global-env))]
+                                      (do @
+                                        [nest? r.bool]
+                                        (if nest?
+                                          (do @
+                                            [num-picks (:: @ map (n/max +1) (pick (inc env-size)))
+                                             picks (|> (r.set number.Hash<Nat> num-picks (pick env-size))
+                                                       (:: @ map set.to-list))
+                                             [arity bodyA predictionA] (recur (inc arity)
+                                                                              (list/map (function (_ pick)
+                                                                                          (maybe.assume (list.nth pick global-env)))
+                                                                                        picks))]
+                                            (wrap [arity
+                                                   (#analysisL.Function (list/map (|>> #analysisL.Foreign) picks)
+                                                                        bodyA)
+                                                   predictionA]))
+                                          (do @
+                                            [chosen (pick (list.size global-env))]
+                                            (wrap [arity
+                                                   (#analysisL.Variable (#analysisL.Foreign chosen))
+                                                   (maybe.assume (dict.get chosen resolver))])))))))]
+    (wrap [arity
+           (#analysisL.Function absolute-env bodyA)
+           predictionA])))
+
+(def: local-function
+  (r.Random [Arity Analysis Variable])
+  (loop [arity +0
+         nest? true]
+    (if nest?
+      (do r.Monad<Random>
+        [nest?' r.bool
+         [arity' bodyA predictionA] (recur (inc arity) nest?')]
+        (wrap [arity'
+               (#analysisL.Function (list) bodyA)
+               predictionA]))
+      (do r.Monad<Random>
+        [chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))]
+        (wrap [arity
+               (#analysisL.Variable (#analysisL.Local chosen))
+               (|> chosen (n/+ (dec arity)) #analysisL.Local)])))))
+
+(context: "Function definition."
+  (<| (times +100)
+      (do @
+        [[arity//constant function//constant prediction//constant] constant-function
+         [arity//environment function//environment prediction//environment] function-with-environment
+         [arity//local function//local prediction//local] local-function]
+        ($_ seq
+            (test "Nested functions will get folded together."
+                  (|> function//constant
+                      (//.run (expressionS.synthesizer extensionL.empty))
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity output])))
+                             (and (n/= arity//constant arity)
+                                  (//primitive.corresponds? prediction//constant output))
+                             
+                             _
+                             (n/= +0 arity//constant))))
+            (test "Folded functions provide direct access to environment variables."
+                  (|> function//environment
+                      (//.run (expressionS.synthesizer extensionL.empty))
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Variable output)])))
+                             (and (n/= arity//environment arity)
+                                  (variable/= prediction//environment output))
+                             
+                             _
+                             false)))
+            (test "Folded functions properly offset local variables."
+                  (|> function//local
+                      (//.run (expressionS.synthesizer extensionL.empty))
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Variable output)])))
+                             (and (n/= arity//local arity)
+                                  (variable/= prediction//local output))
+                             
+                             _
+                             false)))
+            ))))
+
+(context: "Function application."
+  (<| (times +100)
+      (do @
+        [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+         funcA //primitive.primitive
+         argsA (r.list arity //primitive.primitive)]
+        ($_ seq
+            (test "Can synthesize function application."
+                  (|> (analysisL.apply [funcA argsA])
+                      (//.run (expressionS.synthesizer extensionL.empty))
+                      (case> (^ (#error.Success (//.function/apply [funcS argsS])))
+                             (and (//primitive.corresponds? funcA funcS)
+                                  (list.every? (product.uncurry //primitive.corresponds?)
+                                               (list.zip2 argsA argsS)))
+                             
+                             _
+                             false)))
+            (test "Function application on no arguments just synthesizes to the function itself."
+                  (|> (analysisL.apply [funcA (list)])
+                      (//.run (expressionS.synthesizer extensionL.empty))
+                      (case> (#error.Success funcS)
+                             (//primitive.corresponds? funcA funcS)
+
+                             _
+                             false)))
+            ))))
diff --git a/stdlib/test/test/lux/lang/synthesis/primitive.lux b/stdlib/test/test/lux/lang/synthesis/primitive.lux
new file mode 100644
index 000000000..ffe0eb795
--- /dev/null
+++ b/stdlib/test/test/lux/lang/synthesis/primitive.lux
@@ -0,0 +1,90 @@
+(.module:
+  [lux #- primitive]
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [error]
+             text/format)
+       [lang]
+       (lang [".L" extension]
+             [".L" analysis #+ Analysis]
+             ["//" synthesis #+ Synthesis]
+             (synthesis [".S" expression]))
+       ["r" math/random]
+       test))
+
+(def: #export primitive
+  (r.Random Analysis)
+  (do r.Monad<Random>
+    [primitive (: (r.Random analysisL.Primitive)
+                  ($_ r.alt
+                      (wrap [])
+                      r.bool
+                      r.nat
+                      r.int
+                      r.deg
+                      r.frac
+                      (r.unicode +5)))]
+    (wrap (#analysisL.Primitive primitive))))
+
+(def: #export (corresponds? analysis synthesis)
+  (-> Analysis Synthesis Bool)
+  (case [synthesis analysis]
+    [(#//.Primitive (#//.Text valueS))
+     (#analysisL.Primitive (#analysisL.Unit valueA))]
+    (is? valueS (:! Text valueA))
+    
+    [(#//.Primitive (#//.Bool valueS))
+     (#analysisL.Primitive (#analysisL.Bool valueA))]
+    (is? valueS valueA)
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysisL.Primitive (#analysisL.Nat valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysisL.Primitive (#analysisL.Int valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysisL.Primitive (#analysisL.Deg valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.F64 valueS))
+     (#analysisL.Primitive (#analysisL.Frac valueA))]
+    (is? valueS valueA)
+    
+    [(#//.Primitive (#//.Text valueS))
+     (#analysisL.Primitive (#analysisL.Text valueA))]
+    (is? valueS valueA)
+    
+    _
+    false))
+
+(context: "Primitives."
+  (<| (times +100)
+      (do @
+        [%bool% r.bool
+         %nat% r.nat
+         %int% r.int
+         %deg% r.deg
+         %frac% r.frac
+         %text% (r.unicode +5)]
+        (`` ($_ seq
+                (~~ (do-template [<desc> <analysis> <synthesis> <sample>]
+                      [(test (format "Can synthesize " <desc> ".")
+                             (|> (#analysisL.Primitive (<analysis> <sample>))
+                                 (//.run (expressionS.synthesizer extensionL.empty))
+                                 (case> (#error.Success (#//.Primitive (<synthesis> value)))
+                                        (is? <sample> value)
+
+                                        _
+                                        false)))]
+
+                      ["unit" #analysisL.Unit #//.Text //.unit]
+                      ["bool" #analysisL.Bool #//.Bool %bool%]
+                      ["nat"  #analysisL.Nat  #//.I64  (.i64 %nat%)]
+                      ["int"  #analysisL.Int  #//.I64  (.i64 %int%)]
+                      ["deg"  #analysisL.Deg  #//.I64  (.i64 %deg%)]
+                      ["frac" #analysisL.Frac #//.F64  %frac%]
+                      ["text" #analysisL.Text #//.Text %text%])))))))
diff --git a/stdlib/test/test/lux/lang/synthesis/structure.lux b/stdlib/test/test/lux/lang/synthesis/structure.lux
new file mode 100644
index 000000000..a8e298bf5
--- /dev/null
+++ b/stdlib/test/test/lux/lang/synthesis/structure.lux
@@ -0,0 +1,54 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [bool "bool/" Eq<Bool>]
+             [product]
+             [error]
+             (coll [list]))
+       (lang [".L" analysis]
+             ["//" synthesis #+ Synthesis]
+             (synthesis [".S" expression])
+             [".L" extension])
+       ["r" math/random "r/" Monad<Random>]
+       test)
+  [//primitive])
+
+(context: "Variants"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/+ +2))))
+         tagA (|> r.nat (:: @ map (n/% size)))
+         memberA //primitive.primitive]
+        ($_ seq
+            (test "Can synthesize variants."
+                  (|> (analysisL.sum-analysis size tagA memberA)
+                      (//.run (expressionS.synthesizer extensionL.empty))
+                      (case> (#error.Success (#//.Structure (#//.Variant [leftsS right?S valueS])))
+                             (let [tagS (if right?S (inc leftsS) leftsS)]
+                               (and (n/= tagA tagS)
+                                    (|> tagS (n/= (dec size)) (bool/= right?S))
+                                    (//primitive.corresponds? memberA valueS)))
+                             
+                             _
+                             false)))
+            ))))
+
+(context: "Tuples"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         membersA (r.list size //primitive.primitive)]
+        ($_ seq
+            (test "Can synthesize tuple."
+                  (|> (analysisL.product-analysis membersA)
+                      (//.run (expressionS.synthesizer extensionL.empty))
+                      (case> (#error.Success (#//.Structure (#//.Tuple membersS)))
+                             (and (n/= size (list.size membersS))
+                                  (list.every? (product.uncurry //primitive.corresponds?)
+                                               (list.zip2 membersA membersS)))
+
+                             _
+                             false)))
+            ))))