From 71d7a4c7206155e09f3e1e1d8699561ea6967382 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 1 Nov 2017 00:04:43 -0400
Subject: - Re-organized synthesis.
---
new-luxc/source/luxc/eval.lux | 8 +-
new-luxc/source/luxc/generator.lux | 10 +-
new-luxc/source/luxc/generator/eval.jvm.lux | 1 -
new-luxc/source/luxc/generator/expression.jvm.lux | 1 -
new-luxc/source/luxc/generator/function.jvm.lux | 1 -
new-luxc/source/luxc/generator/primitive.jvm.lux | 1 -
.../source/luxc/generator/procedure/common.jvm.lux | 1 -
.../source/luxc/generator/procedure/host.jvm.lux | 1 -
new-luxc/source/luxc/generator/runtime.jvm.lux | 1 -
new-luxc/source/luxc/generator/structure.jvm.lux | 1 -
new-luxc/source/luxc/lang/synthesis/case.lux | 70 ++++++++
new-luxc/source/luxc/lang/synthesis/expression.lux | 184 ++++++++++++++++++++
new-luxc/source/luxc/lang/synthesis/function.lux | 29 ++++
new-luxc/source/luxc/lang/synthesis/loop.lux | 185 +++++++++++++++++++++
new-luxc/source/luxc/lang/synthesis/variable.lux | 98 +++++++++++
new-luxc/source/luxc/synthesizer.lux | 184 --------------------
new-luxc/source/luxc/synthesizer/case.lux | 70 --------
new-luxc/source/luxc/synthesizer/function.lux | 29 ----
new-luxc/source/luxc/synthesizer/loop.lux | 185 ---------------------
new-luxc/source/luxc/synthesizer/variable.lux | 98 -----------
new-luxc/test/test/luxc/generator/case.lux | 1 -
new-luxc/test/test/luxc/generator/function.lux | 1 -
new-luxc/test/test/luxc/generator/primitive.lux | 1 -
.../test/luxc/generator/procedure/common.jvm.lux | 1 -
.../test/luxc/generator/procedure/host.jvm.lux | 1 -
new-luxc/test/test/luxc/generator/structure.lux | 1 -
.../test/test/luxc/lang/synthesis/case/special.lux | 68 ++++++++
new-luxc/test/test/luxc/lang/synthesis/common.lux | 37 +++++
.../test/test/luxc/lang/synthesis/function.lux | 150 +++++++++++++++++
new-luxc/test/test/luxc/lang/synthesis/loop.lux | 159 ++++++++++++++++++
.../test/test/luxc/lang/synthesis/primitive.lux | 45 +++++
.../test/test/luxc/lang/synthesis/procedure.lux | 32 ++++
.../test/test/luxc/lang/synthesis/structure.lux | 49 ++++++
.../test/test/luxc/synthesizer/case/special.lux | 68 --------
new-luxc/test/test/luxc/synthesizer/common.lux | 37 -----
new-luxc/test/test/luxc/synthesizer/function.lux | 150 -----------------
new-luxc/test/test/luxc/synthesizer/loop.lux | 159 ------------------
new-luxc/test/test/luxc/synthesizer/primitive.lux | 45 -----
new-luxc/test/test/luxc/synthesizer/procedure.lux | 32 ----
new-luxc/test/test/luxc/synthesizer/structure.lux | 49 ------
new-luxc/test/tests.lux | 14 +-
41 files changed, 1122 insertions(+), 1136 deletions(-)
create mode 100644 new-luxc/source/luxc/lang/synthesis/case.lux
create mode 100644 new-luxc/source/luxc/lang/synthesis/expression.lux
create mode 100644 new-luxc/source/luxc/lang/synthesis/function.lux
create mode 100644 new-luxc/source/luxc/lang/synthesis/loop.lux
create mode 100644 new-luxc/source/luxc/lang/synthesis/variable.lux
delete mode 100644 new-luxc/source/luxc/synthesizer.lux
delete mode 100644 new-luxc/source/luxc/synthesizer/case.lux
delete mode 100644 new-luxc/source/luxc/synthesizer/function.lux
delete mode 100644 new-luxc/source/luxc/synthesizer/loop.lux
delete mode 100644 new-luxc/source/luxc/synthesizer/variable.lux
create mode 100644 new-luxc/test/test/luxc/lang/synthesis/case/special.lux
create mode 100644 new-luxc/test/test/luxc/lang/synthesis/common.lux
create mode 100644 new-luxc/test/test/luxc/lang/synthesis/function.lux
create mode 100644 new-luxc/test/test/luxc/lang/synthesis/loop.lux
create mode 100644 new-luxc/test/test/luxc/lang/synthesis/primitive.lux
create mode 100644 new-luxc/test/test/luxc/lang/synthesis/procedure.lux
create mode 100644 new-luxc/test/test/luxc/lang/synthesis/structure.lux
delete mode 100644 new-luxc/test/test/luxc/synthesizer/case/special.lux
delete mode 100644 new-luxc/test/test/luxc/synthesizer/common.lux
delete mode 100644 new-luxc/test/test/luxc/synthesizer/function.lux
delete mode 100644 new-luxc/test/test/luxc/synthesizer/loop.lux
delete mode 100644 new-luxc/test/test/luxc/synthesizer/primitive.lux
delete mode 100644 new-luxc/test/test/luxc/synthesizer/procedure.lux
delete mode 100644 new-luxc/test/test/luxc/synthesizer/structure.lux
(limited to 'new-luxc')
diff --git a/new-luxc/source/luxc/eval.lux b/new-luxc/source/luxc/eval.lux
index fdbf8e781..baac56c64 100644
--- a/new-luxc/source/luxc/eval.lux
+++ b/new-luxc/source/luxc/eval.lux
@@ -2,10 +2,10 @@
lux
(lux (control [monad #+ do])
[meta])
- (luxc (lang (analysis [";A" expression])))
+ (luxc (lang (analysis [";A" expression])
+ (synthesis [";S" expression])))
[../base]
- (.. [synthesizer]
- (generator [";G" expression]
+ (.. (generator [";G" expression]
[eval])))
(def: #export (eval type exprC)
@@ -13,6 +13,6 @@
(do meta;Monad
[exprA (../base;with-expected-type type
(expressionA;analyser eval exprC))
- #let [exprS (synthesizer;synthesize exprA)]
+ #let [exprS (expressionS;synthesize exprA)]
exprI (expressionG;generate exprS)]
(eval;eval exprI)))
diff --git a/new-luxc/source/luxc/generator.lux b/new-luxc/source/luxc/generator.lux
index e4d4317fe..e9b6c4d3f 100644
--- a/new-luxc/source/luxc/generator.lux
+++ b/new-luxc/source/luxc/generator.lux
@@ -14,11 +14,11 @@
[";L" host]
["&;" io]
["&;" module]
- ["&;" synthesizer]
["&;" eval]
(lang ["&;" syntax]
(analysis [";A" expression]
- [";A" common]))
+ [";A" common])
+ (synthesis [";S" expression]))
(generator ["&&;" runtime]
["&&;" statement]
["&&;" common]
@@ -41,7 +41,7 @@
[[_ metaA] (&;with-scope
(&;with-expected-type Code
(analyse metaC)))
- metaI (expressionG;generate (&synthesizer;synthesize metaA))
+ metaI (expressionG;generate (expressionS;synthesize metaA))
metaV (&&eval;eval metaI)
[_ valueT valueA] (&;with-scope
(if (meta;type? (:! Code metaV))
@@ -51,7 +51,7 @@
(wrap [Type valueA])))
(commonA;with-unknown-type
(analyse valueC))))
- valueI (expressionG;generate (&synthesizer;synthesize valueA))
+ valueI (expressionG;generate (expressionS;synthesize valueA))
_ (&;with-scope
(&&statement;generate-def def-name valueT valueI metaI (:! Code metaV)))]
(wrap []))
@@ -63,7 +63,7 @@
[[_ programA] (&;with-scope
(&;with-expected-type (type (io;IO Unit))
(analyse programC)))
- programI (expressionG;generate (&synthesizer;synthesize programA))]
+ programI (expressionG;generate (expressionS;synthesize programA))]
(&&statement;generate-program program-args programI))
_
diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux
index 86bede8cd..2f0ce1c24 100644
--- a/new-luxc/source/luxc/generator/eval.jvm.lux
+++ b/new-luxc/source/luxc/generator/eval.jvm.lux
@@ -12,7 +12,6 @@
["$i" inst]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common])
))
diff --git a/new-luxc/source/luxc/generator/expression.jvm.lux b/new-luxc/source/luxc/generator/expression.jvm.lux
index e0f95b48b..798998510 100644
--- a/new-luxc/source/luxc/generator/expression.jvm.lux
+++ b/new-luxc/source/luxc/generator/expression.jvm.lux
@@ -11,7 +11,6 @@
(host ["$" jvm])
(lang ["ls" synthesis]
[";L" variable #+ Variable Register])
- ["&;" synthesizer]
(generator ["&;" common]
["&;" primitive]
["&;" structure]
diff --git a/new-luxc/source/luxc/generator/function.jvm.lux b/new-luxc/source/luxc/generator/function.jvm.lux
index 70b892d41..310f4d7a0 100644
--- a/new-luxc/source/luxc/generator/function.jvm.lux
+++ b/new-luxc/source/luxc/generator/function.jvm.lux
@@ -13,7 +13,6 @@
(lang ["la" analysis]
["ls" synthesis]
[";L" variable #+ Variable])
- ["&;" synthesizer]
(generator ["&;" common]
["&;" runtime])))
diff --git a/new-luxc/source/luxc/generator/primitive.jvm.lux b/new-luxc/source/luxc/generator/primitive.jvm.lux
index f772383d1..637f46a85 100644
--- a/new-luxc/source/luxc/generator/primitive.jvm.lux
+++ b/new-luxc/source/luxc/generator/primitive.jvm.lux
@@ -10,7 +10,6 @@
["$t" type]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common]))
[../runtime])
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
index a8fa81f81..dffbcb64e 100644
--- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
@@ -17,7 +17,6 @@
["$i" inst]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common]
["&;" runtime])))
diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
index 97c8fb87e..9222b2e4a 100644
--- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
@@ -23,7 +23,6 @@
(lang ["la" analysis]
(analysis (procedure ["&;" host]))
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common]
["&;" runtime]))
["@" ../common])
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index fd8fbf74a..4b57e802e 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -14,7 +14,6 @@
["$i" inst]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common])))
(host;import java.lang.Object)
diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux
index b9dced077..96d5767c6 100644
--- a/new-luxc/source/luxc/generator/structure.jvm.lux
+++ b/new-luxc/source/luxc/generator/structure.jvm.lux
@@ -13,7 +13,6 @@
["$i" inst]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common]))
[../runtime])
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
new file mode 100644
index 000000000..15cb6eca3
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -0,0 +1,70 @@
+(;module:
+ lux
+ (lux (data [bool "bool/" Eq]
+ [text "text/" Eq]
+ [number]
+ (coll [list "list/" Fold]))
+ (meta [code "code/" Eq]))
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis])))
+
+(def: #export (path pattern)
+ (-> la;Pattern ls;Path)
+ (case pattern
+ (^code [(~@ membersP)])
+ (case (list;reverse membersP)
+ #;Nil
+ (' ("lux case pop"))
+
+ (#;Cons singletonP #;Nil)
+ (path singletonP)
+
+ (#;Cons lastP prevsP)
+ (let [length (list;size membersP)
+ last-idx (n.dec length)
+ [_ tuple-path] (list/fold (function [current-pattern [current-idx next-path]]
+ [(n.dec current-idx)
+ (` ("lux case seq"
+ ("lux case tuple left" (~ (code;nat current-idx)) (~ (path current-pattern)))
+ (~ next-path)))])
+ [(n.dec last-idx)
+ (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
+ prevsP)]
+ tuple-path))
+
+ (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
+ (if (n.= (n.dec num-tags) tag)
+ (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP))))
+ (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP)))))
+
+ _
+ pattern))
+
+(def: #export (weave leftP rightP)
+ (-> ls;Path ls;Path ls;Path)
+ (with-expansions [ (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
+ (case [leftP rightP]
+ (^template []
+ (^ [[_ (#;Form (list [_ (#;Text )] [_ (#;Nat left-idx)] left-then))]
+ [_ (#;Form (list [_ (#;Text )] [_ (#;Nat right-idx)] right-then))]])
+ (if (n.= left-idx right-idx)
+ (` ( (~ (code;nat left-idx)) (~ (weave left-then right-then))))
+ ))
+ (["lux case tuple left"]
+ ["lux case tuple right"]
+ ["lux case variant left"]
+ ["lux case variant right"])
+
+ (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))]
+ [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]])
+ (case (weave left-pre right-pre)
+ (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))])
+
+
+ weavedP
+ (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
+
+ _
+ (if (code/= leftP rightP)
+ leftP
+ ))))
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
new file mode 100644
index 000000000..05b99923b
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -0,0 +1,184 @@
+(;module:
+ lux
+ (lux (control ["p" parser])
+ (data [maybe]
+ ["e" error]
+ [number]
+ [product]
+ text/format
+ (coll [list "list/" Functor Fold Monoid]
+ [dict #+ Dict]))
+ (meta [code]
+ ["s" syntax]))
+ (luxc ["&" base]
+ (lang ["la" analysis]
+ ["ls" synthesis]
+ (synthesis [";S" case]
+ [";S" function]
+ [";S" loop])
+ [";L" variable #+ Variable])
+ ))
+
+(def: init-env (List Variable) (list))
+(def: init-resolver (Dict Int Int) (dict;new number;Hash))
+
+(def: (prepare-body inner-arity arity body)
+ (-> Nat Nat ls;Synthesis ls;Synthesis)
+ (if (functionS;nested? inner-arity)
+ body
+ (loopS;reify-recursion arity body)))
+
+(def: (let$ register inputS bodyS)
+ (-> Nat ls;Synthesis ls;Synthesis ls;Synthesis)
+ (` ("lux let" (~ (code;nat register)) (~ inputS) (~ bodyS))))
+
+(def: (if$ testS thenS elseS)
+ (-> ls;Synthesis ls;Synthesis ls;Synthesis ls;Synthesis)
+ (` ("lux if" (~ testS)
+ (~ thenS)
+ (~ elseS))))
+
+(def: (function$ arity environment body)
+ (-> ls;Arity (List Variable) ls;Synthesis ls;Synthesis)
+ (` ("lux function" (~ (code;nat arity))
+ [(~@ (list/map code;int environment))]
+ (~ body))))
+
+(def: (variant$ tag last? valueS)
+ (-> Nat Bool ls;Synthesis ls;Synthesis)
+ (` ((~ (code;nat tag)) (~ (code;bool last?)) (~ valueS))))
+
+(def: (var$ var)
+ (-> Variable ls;Synthesis)
+ (` ((~ (code;int var)))))
+
+(def: (procedure$ name argsS)
+ (-> Text (List ls;Synthesis) ls;Synthesis)
+ (` ((~ (code;text name)) (~@ argsS))))
+
+(def: (call$ funcS argsS)
+ (-> ls;Synthesis (List ls;Synthesis) ls;Synthesis)
+ (` ("lux call" (~ funcS) (~@ argsS))))
+
+(def: (synthesize-case synthesize inputA branchesA)
+ (-> (-> la;Analysis ls;Synthesis)
+ la;Analysis (List [la;Pattern la;Analysis])
+ ls;Synthesis)
+ (let [inputS (synthesize inputA)]
+ (case (list;reverse branchesA)
+ (^multi (^ (list [(^code ("lux case bind" (~ [_ (#;Nat input-register)])))
+ (^code ((~ [_ (#;Int var)])))]))
+ (not (variableL;captured? var))
+ (n.= input-register (int-to-nat var)))
+ inputS
+
+ (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
+ (let$ register inputS (synthesize bodyA))
+
+ (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
+ (^ (list [(^code false) elseA] [(^code true) thenA])))
+ (if$ inputS (synthesize thenA) (synthesize elseA))
+
+ (#;Cons [lastP lastA] prevsPA)
+ (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path)
+ (function [pattern expr]
+ (|> (synthesize expr)
+ (~) ("lux case exec")
+ ("lux case seq" (~ (caseS;path pattern)))
+ (`))))]
+ (` ("lux case" (~ inputS)
+ (~ (list/fold caseS;weave
+ (transform-branch lastP lastA)
+ (list/map (product;uncurry transform-branch) prevsPA))))))
+
+ _
+ (undefined)
+ )))
+
+(def: (synthesize-apply synthesize outer-arity num-locals exprA)
+ (-> (-> la;Analysis ls;Synthesis) ls;Arity Nat la;Analysis ls;Synthesis)
+ (let [[funcA argsA] (functionS;unfold-apply exprA)
+ funcS (synthesize funcA)
+ argsS (list/map synthesize argsA)]
+ (case funcS
+ (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _bodyS))])
+ (and (n.= _arity (list;size argsS))
+ (not (loopS;contains-self-reference? _bodyS)))
+ [(s;run _env (p;some s;int)) (#e;Success _env)])
+ (let [register-offset (if (functionS;top? outer-arity)
+ num-locals
+ (|> outer-arity n.inc (n.+ num-locals)))]
+ (` ("lux loop" (~ (code;nat register-offset)) [(~@ argsS)]
+ (~ (loopS;adjust _env register-offset _bodyS)))))
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS' argsS'))])
+ (call$ funcS' (list/compose argsS' argsS))
+
+ _
+ (call$ funcS argsS))))
+
+(def: #export (synthesize analysis)
+ (-> la;Analysis ls;Synthesis)
+ (loop [outer-arity +0
+ resolver init-resolver
+ num-locals +0
+ exprA analysis]
+ (case exprA
+ (^code [(~ _left) (~ _right)])
+ (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))])
+
+ (^or (^code ("lux sum left" (~ _)))
+ (^code ("lux sum right" (~ _))))
+ (let [[tag last? value] (maybe;assume (la;unfold-variant exprA))]
+ (variant$ tag last? (recur +0 resolver num-locals value)))
+
+ (^code ((~ [_ (#;Int var)])))
+ (if (variableL;local? var)
+ (let [register (variableL;local-register var)]
+ (if (functionS;nested? outer-arity)
+ (if (n.= +0 register)
+ (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
+ (list/map (|>. variableL;local code;int (~) () (`)))))
+ (var$ (functionS;adjust-var outer-arity (variableL;local register))))
+ (var$ (variableL;local register))))
+ (let [register (variableL;captured-register var)]
+ (var$ (let [var (variableL;captured register)]
+ (maybe;default var (dict;get var resolver))))))
+
+ (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
+ (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
+
+ (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
+ [(s;run scope (p;some s;int)) (#e;Success raw-env)])
+ (let [inner-arity (n.inc outer-arity)
+ env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
+ env-vars (let [env-size (list;size raw-env)]
+ (: (List Variable)
+ (case env-size
+ +0 (list)
+ _ (list/map variableL;captured (list;n.range +0 (n.dec env-size))))))
+ resolver' (if (functionS;nested? inner-arity)
+ (list/fold (function [[from to] resolver']
+ (dict;put from to resolver'))
+ init-resolver
+ (list;zip2 env-vars env))
+ (list/fold (function [var resolver']
+ (dict;put var var resolver'))
+ init-resolver
+ env-vars))]
+ (case (recur inner-arity resolver' +0 bodyA)
+ (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
+ (let [arity (n.inc arity')]
+ (function$ arity env (prepare-body inner-arity arity bodyS')))
+
+ bodyS
+ (function$ +1 env (prepare-body inner-arity +1 bodyS))))
+
+ (^code ("lux apply" (~@ _)))
+ (synthesize-apply synthesize outer-arity num-locals exprA)
+
+ (^code ((~ [_ (#;Text name)]) (~@ args)))
+ (procedure$ name (list/map (recur +0 resolver num-locals) args))
+
+ _
+ exprA)))
diff --git a/new-luxc/source/luxc/lang/synthesis/function.lux b/new-luxc/source/luxc/lang/synthesis/function.lux
new file mode 100644
index 000000000..52aee9a49
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/function.lux
@@ -0,0 +1,29 @@
+(;module:
+ lux
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ [";L" variable #+ Variable])))
+
+(do-template [ []
+ [(def: #export ( arity)
+ (-> ls;Arity Bool)
+ ( ][ arity))]
+
+ [nested? n.> +1]
+ [top? n.= +0]
+ )
+
+(def: #export (adjust-var outer var)
+ (-> ls;Arity Variable Variable)
+ (|> outer n.dec nat-to-int (i.+ var)))
+
+(def: #export (unfold-apply apply)
+ (-> la;Analysis [la;Analysis (List la;Analysis)])
+ (loop [apply apply
+ args (list)]
+ (case apply
+ (^code ("lux apply" (~ arg) (~ func)))
+ (recur func (#;Cons arg args))
+
+ _
+ [apply args])))
diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux
new file mode 100644
index 000000000..0070fcd5d
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/loop.lux
@@ -0,0 +1,185 @@
+(;module:
+ lux
+ (lux (control [monad #+ do]
+ ["p" parser])
+ (data [maybe]
+ (coll [list "list/" Functor]]))
+ (meta [code]
+ [syntax]))
+ (luxc (lang ["ls" synthesis]
+ [";L" variable #+ Variable Register])))
+
+(def: #export (contains-self-reference? exprS)
+ (-> ls;Synthesis Bool)
+ (case exprS
+ (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] memberS))])
+ (contains-self-reference? memberS)
+
+ [_ (#;Tuple membersS)]
+ (list;any? contains-self-reference? membersS)
+
+ (^ [_ (#;Form (list [_ (#;Int var)]))])
+ (variableL;self? var)
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
+ (or (contains-self-reference? inputS)
+ (loop [pathS pathS]
+ (case pathS
+ (^or (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
+ (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]))
+ (or (recur leftS)
+ (recur rightS))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (contains-self-reference? bodyS)
+
+ _
+ false)))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
+ (list;any? (function [captured]
+ (case captured
+ (^ [_ (#;Form (list [_ (#;Int var)]))])
+ (variableL;self? var)
+
+ _
+ false))
+ environment)
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
+ (or (contains-self-reference? funcS)
+ (list;any? contains-self-reference? argsS))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
+ (or (contains-self-reference? inputS)
+ (contains-self-reference? bodyS))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (or (contains-self-reference? inputS)
+ (contains-self-reference? thenS)
+ (contains-self-reference? elseS))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux loop")] offset [_ (#;Tuple initsS)] bodyS))])
+ (or (list;any? contains-self-reference? initsS)
+ (contains-self-reference? bodyS))
+
+ (^or (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
+ (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]))
+ (list;any? contains-self-reference? argsS)
+
+ _
+ false
+ ))
+
+(def: #export (reify-recursion arity exprS)
+ (-> Nat ls;Synthesis ls;Synthesis)
+ (loop [exprS exprS]
+ (case exprS
+ (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
+ (` ("lux case" (~ inputS)
+ (~ (let [reify-recursion' recur]
+ (loop [pathS pathS]
+ (case pathS
+ (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
+ (` ("lux case alt" (~ (recur leftS)) (~ (recur rightS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])
+ (` ("lux case seq" (~ leftS) (~ (recur rightS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (` ("lux case exec" (~ (reify-recursion' bodyS))))
+
+ _
+ pathS))))))
+
+ (^multi (^ [_ (#;Form (list& [_ (#;Text "lux call")]
+ [_ (#;Form (list [_ (#;Int 0)]))]
+ argsS))])
+ (n.= arity (list;size argsS)))
+ (` ("lux recur" (~@ argsS)))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
+ (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (` ("lux if" (~ inputS) (~ (recur thenS)) (~ (recur elseS))))
+
+ _
+ exprS
+ )))
+
+(def: #export (adjust env outer-offset exprS)
+ (-> (List Variable) Register ls;Synthesis ls;Synthesis)
+ (let [resolve-captured (: (-> Variable Variable)
+ (function [var]
+ (let [idx (|> var (i.* -1) int-to-nat n.dec)]
+ (|> env (list;nth idx) maybe;assume))))]
+ (loop [exprS exprS]
+ (case exprS
+ (^ [_ (#;Form (list [_ (#;Nat tag)] last? valueS))])
+ (` ((~ (code;nat tag)) (~ last?) (~ (recur valueS))))
+
+ [_ (#;Tuple members)]
+ [_ (#;Tuple (list/map recur members))]
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
+ (` ("lux case" (~ (recur inputS))
+ (~ (let [adjust' recur]
+ (loop [pathS pathS]
+ (case pathS
+ (^template []
+ (^ [_ (#;Form (list [_ (#;Text )] leftS rightS))])
+ (` ( (~ (recur leftS)) (~ (recur rightS)))))
+ (["lux case alt"]
+ ["lux case seq"])
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (` ("lux case exec" (~ (adjust' bodyS))))
+
+ _
+ pathS))))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
+ (` ("lux function" (~ arity)
+ (~ [_ (#;Tuple (list/map (function [_var]
+ (case _var
+ (^ [_ (#;Form (list [_ (#;Int var)]))])
+ (` ((~ (code;int (resolve-captured var)))))
+
+ _
+ _var))
+ environment))])
+ (~ (recur bodyS))))
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
+ (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS))))
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
+ (` ("lux recur" (~@ (list/map recur argsS))))
+
+ (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
+ (` ((~ (code;text procedure)) (~@ (list/map recur argsS))))
+
+ (^ [_ (#;Form (list [_ (#;Int var)]))])
+ (if (variableL;captured? var)
+ (` ((~ (code;int (resolve-captured var)))))
+ (` ((~ (code;int (|> outer-offset nat-to-int (i.+ var)))))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS bodyS))])
+ (` ("lux let" (~ (code;nat (n.+ outer-offset register)))
+ (~ (recur inputS))
+ (~ (recur bodyS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (` ("lux if" (~ (recur inputS))
+ (~ (recur thenS))
+ (~ (recur elseS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat inner-offset)] [_ (#;Tuple initsS)] bodyS))])
+ (` ("lux loop" (~ (code;nat (n.+ outer-offset inner-offset)))
+ [(~@ (list/map recur initsS))]
+ (~ (recur bodyS))))
+
+ _
+ exprS
+ ))))
diff --git a/new-luxc/source/luxc/lang/synthesis/variable.lux b/new-luxc/source/luxc/lang/synthesis/variable.lux
new file mode 100644
index 000000000..3ce9f2678
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/variable.lux
@@ -0,0 +1,98 @@
+(;module:
+ lux
+ (lux (data [number]
+ (coll [list "list/" Fold Monoid]
+ ["s" set])))
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ [";L" variable #+ Variable])))
+
+(def: (bound-vars path)
+ (-> ls;Path (List Variable))
+ (case path
+ (#ls;BindP register)
+ (list (nat-to-int register))
+
+ (^or (#ls;SeqP pre post) (#ls;AltP pre post))
+ (list/compose (bound-vars pre) (bound-vars post))
+
+ _
+ (list)))
+
+(def: (path-bodies path)
+ (-> ls;Path (List ls;Synthesis))
+ (case path
+ (#ls;ExecP body)
+ (list body)
+
+ (#ls;SeqP pre post)
+ (path-bodies post)
+
+ (#ls;AltP pre post)
+ (list/compose (path-bodies pre) (path-bodies post))
+
+ _
+ (list)))
+
+(def: (non-arg? arity var)
+ (-> ls;Arity Variable Bool)
+ (and (variableL;local? var)
+ (n.> arity (int-to-nat var))))
+
+(type: Tracker (s;Set Variable))
+
+(def: init-tracker Tracker (s;new number;Hash))
+
+(def: (unused-vars current-arity bound exprS)
+ (-> ls;Arity (List Variable) ls;Synthesis (List Variable))
+ (let [tracker (loop [exprS exprS
+ tracker (list/fold s;add init-tracker bound)]
+ (case exprS
+ (#ls;Variable var)
+ (if (non-arg? current-arity var)
+ (s;remove var tracker)
+ tracker)
+
+ (#ls;Variant tag last? memberS)
+ (recur memberS tracker)
+
+ (#ls;Tuple membersS)
+ (list/fold recur tracker membersS)
+
+ (#ls;Call funcS argsS)
+ (list/fold recur (recur funcS tracker) argsS)
+
+ (^or (#ls;Recur argsS)
+ (#ls;Procedure name argsS))
+ (list/fold recur tracker argsS)
+
+ (#ls;Let offset inputS outputS)
+ (|> tracker (recur inputS) (recur outputS))
+
+ (#ls;If testS thenS elseS)
+ (|> tracker (recur testS) (recur thenS) (recur elseS))
+
+ (#ls;Loop offset initsS bodyS)
+ (recur bodyS (list/fold recur tracker initsS))
+
+ (#ls;Case inputS outputPS)
+ (let [tracker' (list/fold s;add
+ (recur inputS tracker)
+ (bound-vars outputPS))]
+ (list/fold recur tracker' (path-bodies outputPS)))
+
+ (#ls;Function arity env bodyS)
+ (list/fold s;remove tracker env)
+
+ _
+ tracker
+ ))]
+ (s;to-list tracker)))
+
+## (def: (optimize-register-use current-arity [pathS bodyS])
+## (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis])
+## (let [bound (bound-vars pathS)
+## unused (unused-vars current-arity bound bodyS)
+## adjusted (adjust-vars unused bound)]
+## [(|> pathS (clean-pattern adjusted) simplify-pattern)
+## (clean-expression adjusted bodyS)]))
diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
deleted file mode 100644
index c43958890..000000000
--- a/new-luxc/source/luxc/synthesizer.lux
+++ /dev/null
@@ -1,184 +0,0 @@
-(;module:
- lux
- (lux (control ["p" parser])
- (data [maybe]
- ["e" error]
- [number]
- [product]
- text/format
- (coll [list "list/" Functor Fold Monoid]
- [dict #+ Dict]))
- (meta [code]
- ["s" syntax]))
- (luxc ["&" base]
- (lang ["la" analysis]
- ["ls" synthesis]
- [";L" variable #+ Variable])
- (synthesizer ["&&;" case]
- ["&&;" function]
- ["&&;" loop])
- ))
-
-(def: init-env (List Variable) (list))
-(def: init-resolver (Dict Int Int) (dict;new number;Hash))
-
-(def: (prepare-body inner-arity arity body)
- (-> Nat Nat ls;Synthesis ls;Synthesis)
- (if (&&function;nested? inner-arity)
- body
- (&&loop;reify-recursion arity body)))
-
-(def: (let$ register inputS bodyS)
- (-> Nat ls;Synthesis ls;Synthesis ls;Synthesis)
- (` ("lux let" (~ (code;nat register)) (~ inputS) (~ bodyS))))
-
-(def: (if$ testS thenS elseS)
- (-> ls;Synthesis ls;Synthesis ls;Synthesis ls;Synthesis)
- (` ("lux if" (~ testS)
- (~ thenS)
- (~ elseS))))
-
-(def: (function$ arity environment body)
- (-> ls;Arity (List Variable) ls;Synthesis ls;Synthesis)
- (` ("lux function" (~ (code;nat arity))
- [(~@ (list/map code;int environment))]
- (~ body))))
-
-(def: (variant$ tag last? valueS)
- (-> Nat Bool ls;Synthesis ls;Synthesis)
- (` ((~ (code;nat tag)) (~ (code;bool last?)) (~ valueS))))
-
-(def: (var$ var)
- (-> Variable ls;Synthesis)
- (` ((~ (code;int var)))))
-
-(def: (procedure$ name argsS)
- (-> Text (List ls;Synthesis) ls;Synthesis)
- (` ((~ (code;text name)) (~@ argsS))))
-
-(def: (call$ funcS argsS)
- (-> ls;Synthesis (List ls;Synthesis) ls;Synthesis)
- (` ("lux call" (~ funcS) (~@ argsS))))
-
-(def: (synthesize-case synthesize inputA branchesA)
- (-> (-> la;Analysis ls;Synthesis)
- la;Analysis (List [la;Pattern la;Analysis])
- ls;Synthesis)
- (let [inputS (synthesize inputA)]
- (case (list;reverse branchesA)
- (^multi (^ (list [(^code ("lux case bind" (~ [_ (#;Nat input-register)])))
- (^code ((~ [_ (#;Int var)])))]))
- (not (variableL;captured? var))
- (n.= input-register (int-to-nat var)))
- inputS
-
- (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
- (let$ register inputS (synthesize bodyA))
-
- (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
- (^ (list [(^code false) elseA] [(^code true) thenA])))
- (if$ inputS (synthesize thenA) (synthesize elseA))
-
- (#;Cons [lastP lastA] prevsPA)
- (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path)
- (function [pattern expr]
- (|> (synthesize expr)
- (~) ("lux case exec")
- ("lux case seq" (~ (&&case;path pattern)))
- (`))))]
- (` ("lux case" (~ inputS)
- (~ (list/fold &&case;weave
- (transform-branch lastP lastA)
- (list/map (product;uncurry transform-branch) prevsPA))))))
-
- _
- (undefined)
- )))
-
-(def: (synthesize-apply synthesize outer-arity num-locals exprA)
- (-> (-> la;Analysis ls;Synthesis) ls;Arity Nat la;Analysis ls;Synthesis)
- (let [[funcA argsA] (&&function;unfold-apply exprA)
- funcS (synthesize funcA)
- argsS (list/map synthesize argsA)]
- (case funcS
- (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _bodyS))])
- (and (n.= _arity (list;size argsS))
- (not (&&loop;contains-self-reference? _bodyS)))
- [(s;run _env (p;some s;int)) (#e;Success _env)])
- (let [register-offset (if (&&function;top? outer-arity)
- num-locals
- (|> outer-arity n.inc (n.+ num-locals)))]
- (` ("lux loop" (~ (code;nat register-offset)) [(~@ argsS)]
- (~ (&&loop;adjust _env register-offset _bodyS)))))
-
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS' argsS'))])
- (call$ funcS' (list/compose argsS' argsS))
-
- _
- (call$ funcS argsS))))
-
-(def: #export (synthesize analysis)
- (-> la;Analysis ls;Synthesis)
- (loop [outer-arity +0
- resolver init-resolver
- num-locals +0
- exprA analysis]
- (case exprA
- (^code [(~ _left) (~ _right)])
- (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))])
-
- (^or (^code ("lux sum left" (~ _)))
- (^code ("lux sum right" (~ _))))
- (let [[tag last? value] (maybe;assume (la;unfold-variant exprA))]
- (variant$ tag last? (recur +0 resolver num-locals value)))
-
- (^code ((~ [_ (#;Int var)])))
- (if (variableL;local? var)
- (let [register (variableL;local-register var)]
- (if (&&function;nested? outer-arity)
- (if (n.= +0 register)
- (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
- (list/map (|>. variableL;local code;int (~) () (`)))))
- (var$ (&&function;adjust-var outer-arity (variableL;local register))))
- (var$ (variableL;local register))))
- (let [register (variableL;captured-register var)]
- (var$ (let [var (variableL;captured register)]
- (maybe;default var (dict;get var resolver))))))
-
- (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
- (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
-
- (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
- [(s;run scope (p;some s;int)) (#e;Success raw-env)])
- (let [inner-arity (n.inc outer-arity)
- env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
- env-vars (let [env-size (list;size raw-env)]
- (: (List Variable)
- (case env-size
- +0 (list)
- _ (list/map variableL;captured (list;n.range +0 (n.dec env-size))))))
- resolver' (if (&&function;nested? inner-arity)
- (list/fold (function [[from to] resolver']
- (dict;put from to resolver'))
- init-resolver
- (list;zip2 env-vars env))
- (list/fold (function [var resolver']
- (dict;put var var resolver'))
- init-resolver
- env-vars))]
- (case (recur inner-arity resolver' +0 bodyA)
- (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
- (let [arity (n.inc arity')]
- (function$ arity env (prepare-body inner-arity arity bodyS')))
-
- bodyS
- (function$ +1 env (prepare-body inner-arity +1 bodyS))))
-
- (^code ("lux apply" (~@ _)))
- (synthesize-apply synthesize outer-arity num-locals exprA)
-
- (^code ((~ [_ (#;Text name)]) (~@ args)))
- (procedure$ name (list/map (recur +0 resolver num-locals) args))
-
- _
- exprA)))
diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux
deleted file mode 100644
index 15cb6eca3..000000000
--- a/new-luxc/source/luxc/synthesizer/case.lux
+++ /dev/null
@@ -1,70 +0,0 @@
-(;module:
- lux
- (lux (data [bool "bool/" Eq]
- [text "text/" Eq]
- [number]
- (coll [list "list/" Fold]))
- (meta [code "code/" Eq]))
- (luxc (lang ["la" analysis]
- ["ls" synthesis])))
-
-(def: #export (path pattern)
- (-> la;Pattern ls;Path)
- (case pattern
- (^code [(~@ membersP)])
- (case (list;reverse membersP)
- #;Nil
- (' ("lux case pop"))
-
- (#;Cons singletonP #;Nil)
- (path singletonP)
-
- (#;Cons lastP prevsP)
- (let [length (list;size membersP)
- last-idx (n.dec length)
- [_ tuple-path] (list/fold (function [current-pattern [current-idx next-path]]
- [(n.dec current-idx)
- (` ("lux case seq"
- ("lux case tuple left" (~ (code;nat current-idx)) (~ (path current-pattern)))
- (~ next-path)))])
- [(n.dec last-idx)
- (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
- prevsP)]
- tuple-path))
-
- (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
- (if (n.= (n.dec num-tags) tag)
- (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP))))
- (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP)))))
-
- _
- pattern))
-
-(def: #export (weave leftP rightP)
- (-> ls;Path ls;Path ls;Path)
- (with-expansions [ (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
- (case [leftP rightP]
- (^template []
- (^ [[_ (#;Form (list [_ (#;Text )] [_ (#;Nat left-idx)] left-then))]
- [_ (#;Form (list [_ (#;Text )] [_ (#;Nat right-idx)] right-then))]])
- (if (n.= left-idx right-idx)
- (` ( (~ (code;nat left-idx)) (~ (weave left-then right-then))))
- ))
- (["lux case tuple left"]
- ["lux case tuple right"]
- ["lux case variant left"]
- ["lux case variant right"])
-
- (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))]
- [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]])
- (case (weave left-pre right-pre)
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))])
-
-
- weavedP
- (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
-
- _
- (if (code/= leftP rightP)
- leftP
- ))))
diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux
deleted file mode 100644
index 52aee9a49..000000000
--- a/new-luxc/source/luxc/synthesizer/function.lux
+++ /dev/null
@@ -1,29 +0,0 @@
-(;module:
- lux
- (luxc (lang ["la" analysis]
- ["ls" synthesis]
- [";L" variable #+ Variable])))
-
-(do-template [ []
- [(def: #export ( arity)
- (-> ls;Arity Bool)
- ( ][ arity))]
-
- [nested? n.> +1]
- [top? n.= +0]
- )
-
-(def: #export (adjust-var outer var)
- (-> ls;Arity Variable Variable)
- (|> outer n.dec nat-to-int (i.+ var)))
-
-(def: #export (unfold-apply apply)
- (-> la;Analysis [la;Analysis (List la;Analysis)])
- (loop [apply apply
- args (list)]
- (case apply
- (^code ("lux apply" (~ arg) (~ func)))
- (recur func (#;Cons arg args))
-
- _
- [apply args])))
diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux
deleted file mode 100644
index 0070fcd5d..000000000
--- a/new-luxc/source/luxc/synthesizer/loop.lux
+++ /dev/null
@@ -1,185 +0,0 @@
-(;module:
- lux
- (lux (control [monad #+ do]
- ["p" parser])
- (data [maybe]
- (coll [list "list/" Functor]]))
- (meta [code]
- [syntax]))
- (luxc (lang ["ls" synthesis]
- [";L" variable #+ Variable Register])))
-
-(def: #export (contains-self-reference? exprS)
- (-> ls;Synthesis Bool)
- (case exprS
- (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] memberS))])
- (contains-self-reference? memberS)
-
- [_ (#;Tuple membersS)]
- (list;any? contains-self-reference? membersS)
-
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (variableL;self? var)
-
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
- (or (contains-self-reference? inputS)
- (loop [pathS pathS]
- (case pathS
- (^or (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]))
- (or (recur leftS)
- (recur rightS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (contains-self-reference? bodyS)
-
- _
- false)))
-
- (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
- (list;any? (function [captured]
- (case captured
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (variableL;self? var)
-
- _
- false))
- environment)
-
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
- (or (contains-self-reference? funcS)
- (list;any? contains-self-reference? argsS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
- (or (contains-self-reference? inputS)
- (contains-self-reference? bodyS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
- (or (contains-self-reference? inputS)
- (contains-self-reference? thenS)
- (contains-self-reference? elseS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux loop")] offset [_ (#;Tuple initsS)] bodyS))])
- (or (list;any? contains-self-reference? initsS)
- (contains-self-reference? bodyS))
-
- (^or (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
- (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]))
- (list;any? contains-self-reference? argsS)
-
- _
- false
- ))
-
-(def: #export (reify-recursion arity exprS)
- (-> Nat ls;Synthesis ls;Synthesis)
- (loop [exprS exprS]
- (case exprS
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
- (` ("lux case" (~ inputS)
- (~ (let [reify-recursion' recur]
- (loop [pathS pathS]
- (case pathS
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
- (` ("lux case alt" (~ (recur leftS)) (~ (recur rightS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])
- (` ("lux case seq" (~ leftS) (~ (recur rightS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (` ("lux case exec" (~ (reify-recursion' bodyS))))
-
- _
- pathS))))))
-
- (^multi (^ [_ (#;Form (list& [_ (#;Text "lux call")]
- [_ (#;Form (list [_ (#;Int 0)]))]
- argsS))])
- (n.= arity (list;size argsS)))
- (` ("lux recur" (~@ argsS)))
-
- (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
- (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
- (` ("lux if" (~ inputS) (~ (recur thenS)) (~ (recur elseS))))
-
- _
- exprS
- )))
-
-(def: #export (adjust env outer-offset exprS)
- (-> (List Variable) Register ls;Synthesis ls;Synthesis)
- (let [resolve-captured (: (-> Variable Variable)
- (function [var]
- (let [idx (|> var (i.* -1) int-to-nat n.dec)]
- (|> env (list;nth idx) maybe;assume))))]
- (loop [exprS exprS]
- (case exprS
- (^ [_ (#;Form (list [_ (#;Nat tag)] last? valueS))])
- (` ((~ (code;nat tag)) (~ last?) (~ (recur valueS))))
-
- [_ (#;Tuple members)]
- [_ (#;Tuple (list/map recur members))]
-
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
- (` ("lux case" (~ (recur inputS))
- (~ (let [adjust' recur]
- (loop [pathS pathS]
- (case pathS
- (^template []
- (^ [_ (#;Form (list [_ (#;Text )] leftS rightS))])
- (` ( (~ (recur leftS)) (~ (recur rightS)))))
- (["lux case alt"]
- ["lux case seq"])
-
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (` ("lux case exec" (~ (adjust' bodyS))))
-
- _
- pathS))))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
- (` ("lux function" (~ arity)
- (~ [_ (#;Tuple (list/map (function [_var]
- (case _var
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (` ((~ (code;int (resolve-captured var)))))
-
- _
- _var))
- environment))])
- (~ (recur bodyS))))
-
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
- (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS))))
-
- (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
- (` ("lux recur" (~@ (list/map recur argsS))))
-
- (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
- (` ((~ (code;text procedure)) (~@ (list/map recur argsS))))
-
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (if (variableL;captured? var)
- (` ((~ (code;int (resolve-captured var)))))
- (` ((~ (code;int (|> outer-offset nat-to-int (i.+ var)))))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS bodyS))])
- (` ("lux let" (~ (code;nat (n.+ outer-offset register)))
- (~ (recur inputS))
- (~ (recur bodyS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
- (` ("lux if" (~ (recur inputS))
- (~ (recur thenS))
- (~ (recur elseS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat inner-offset)] [_ (#;Tuple initsS)] bodyS))])
- (` ("lux loop" (~ (code;nat (n.+ outer-offset inner-offset)))
- [(~@ (list/map recur initsS))]
- (~ (recur bodyS))))
-
- _
- exprS
- ))))
diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux
deleted file mode 100644
index 3ce9f2678..000000000
--- a/new-luxc/source/luxc/synthesizer/variable.lux
+++ /dev/null
@@ -1,98 +0,0 @@
-(;module:
- lux
- (lux (data [number]
- (coll [list "list/" Fold Monoid]
- ["s" set])))
- (luxc (lang ["la" analysis]
- ["ls" synthesis]
- [";L" variable #+ Variable])))
-
-(def: (bound-vars path)
- (-> ls;Path (List Variable))
- (case path
- (#ls;BindP register)
- (list (nat-to-int register))
-
- (^or (#ls;SeqP pre post) (#ls;AltP pre post))
- (list/compose (bound-vars pre) (bound-vars post))
-
- _
- (list)))
-
-(def: (path-bodies path)
- (-> ls;Path (List ls;Synthesis))
- (case path
- (#ls;ExecP body)
- (list body)
-
- (#ls;SeqP pre post)
- (path-bodies post)
-
- (#ls;AltP pre post)
- (list/compose (path-bodies pre) (path-bodies post))
-
- _
- (list)))
-
-(def: (non-arg? arity var)
- (-> ls;Arity Variable Bool)
- (and (variableL;local? var)
- (n.> arity (int-to-nat var))))
-
-(type: Tracker (s;Set Variable))
-
-(def: init-tracker Tracker (s;new number;Hash))
-
-(def: (unused-vars current-arity bound exprS)
- (-> ls;Arity (List Variable) ls;Synthesis (List Variable))
- (let [tracker (loop [exprS exprS
- tracker (list/fold s;add init-tracker bound)]
- (case exprS
- (#ls;Variable var)
- (if (non-arg? current-arity var)
- (s;remove var tracker)
- tracker)
-
- (#ls;Variant tag last? memberS)
- (recur memberS tracker)
-
- (#ls;Tuple membersS)
- (list/fold recur tracker membersS)
-
- (#ls;Call funcS argsS)
- (list/fold recur (recur funcS tracker) argsS)
-
- (^or (#ls;Recur argsS)
- (#ls;Procedure name argsS))
- (list/fold recur tracker argsS)
-
- (#ls;Let offset inputS outputS)
- (|> tracker (recur inputS) (recur outputS))
-
- (#ls;If testS thenS elseS)
- (|> tracker (recur testS) (recur thenS) (recur elseS))
-
- (#ls;Loop offset initsS bodyS)
- (recur bodyS (list/fold recur tracker initsS))
-
- (#ls;Case inputS outputPS)
- (let [tracker' (list/fold s;add
- (recur inputS tracker)
- (bound-vars outputPS))]
- (list/fold recur tracker' (path-bodies outputPS)))
-
- (#ls;Function arity env bodyS)
- (list/fold s;remove tracker env)
-
- _
- tracker
- ))]
- (s;to-list tracker)))
-
-## (def: (optimize-register-use current-arity [pathS bodyS])
-## (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis])
-## (let [bound (bound-vars pathS)
-## unused (unused-vars current-arity bound bodyS)
-## adjusted (adjust-vars unused bound)]
-## [(|> pathS (clean-pattern adjusted) simplify-pattern)
-## (clean-expression adjusted bodyS)]))
diff --git a/new-luxc/test/test/luxc/generator/case.lux b/new-luxc/test/test/luxc/generator/case.lux
index 7763cd852..e4201a30b 100644
--- a/new-luxc/test/test/luxc/generator/case.lux
+++ b/new-luxc/test/test/luxc/generator/case.lux
@@ -11,7 +11,6 @@
(meta [code])
test)
(luxc (lang ["ls" synthesis])
- [synthesizer]
(generator ["@" case]
[";G" expression]
["@;" eval]
diff --git a/new-luxc/test/test/luxc/generator/function.lux b/new-luxc/test/test/luxc/generator/function.lux
index e7a0e7d61..2db2719b7 100644
--- a/new-luxc/test/test/luxc/generator/function.lux
+++ b/new-luxc/test/test/luxc/generator/function.lux
@@ -14,7 +14,6 @@
[host]
test)
(luxc (lang ["ls" synthesis])
- [synthesizer]
(generator [";G" expression]
["@;" eval]
["@;" runtime]
diff --git a/new-luxc/test/test/luxc/generator/primitive.lux b/new-luxc/test/test/luxc/generator/primitive.lux
index 6de14d0e5..1ce93cee9 100644
--- a/new-luxc/test/test/luxc/generator/primitive.lux
+++ b/new-luxc/test/test/luxc/generator/primitive.lux
@@ -13,7 +13,6 @@
test)
(luxc [";L" host]
(lang ["ls" synthesis])
- [synthesizer]
(generator [";G" expression]
["@;" runtime]
["@;" eval]
diff --git a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux
index 5e3c07bea..0c24a4020 100644
--- a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux
@@ -17,7 +17,6 @@
[host]
test)
(luxc (lang ["ls" synthesis])
- [synthesizer]
(generator [";G" expression]
["@;" eval]
["@;" runtime]
diff --git a/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux
index d571c578b..91b20d3d4 100644
--- a/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux
+++ b/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux
@@ -18,7 +18,6 @@
test)
(luxc [";L" host]
(lang ["ls" synthesis])
- [synthesizer]
(generator [";G" expression]
["@;" eval]
["@;" runtime]
diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux
index 37320fa99..7c342dbc4 100644
--- a/new-luxc/test/test/luxc/generator/structure.lux
+++ b/new-luxc/test/test/luxc/generator/structure.lux
@@ -17,7 +17,6 @@
test)
(luxc [";L" host]
(lang ["ls" synthesis])
- [synthesizer]
(generator [";G" expression]
["@;" eval]
["@;" runtime]
diff --git a/new-luxc/test/test/luxc/lang/synthesis/case/special.lux b/new-luxc/test/test/luxc/lang/synthesis/case/special.lux
new file mode 100644
index 000000000..585c7d349
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/synthesis/case/special.lux
@@ -0,0 +1,68 @@
+(;module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (meta [code])
+ ["r" math/random "r/" Monad]
+ test)
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ (synthesis [";S" expression])
+ [";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."
+ (|> (expressionS;synthesize 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."
+ (|> (expressionS;synthesize 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."
+ (|> (expressionS;synthesize ifA)
+ (case> (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (and (corresponds? inputA inputS)
+ (corresponds? thenA thenS)
+ (corresponds? elseA elseS))
+
+ _
+ false))))))
diff --git a/new-luxc/test/test/luxc/lang/synthesis/common.lux b/new-luxc/test/test/luxc/lang/synthesis/common.lux
new file mode 100644
index 000000000..a74c64402
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/synthesis/common.lux
@@ -0,0 +1,37 @@
+(;module:
+ lux
+ (lux (data [bool "bool/" Eq]
+ [text "text/" Eq])
+ (meta [code])
+ ["r" math/random "r/" Monad])
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis])))
+
+(def: #export gen-primitive
+ (r;Random la;Analysis)
+ (r;either (r;either (r;either (r/wrap (' []))
+ (r/map code;bool r;bool))
+ (r;either (r/map code;nat r;nat)
+ (r/map code;int r;int)))
+ (r;either (r;either (r/map code;deg r;deg)
+ (r/map code;frac r;frac))
+ (r/map code;text (r;text +5)))))
+
+(def: #export (corresponds? analysis synthesis)
+ (-> la;Analysis ls;Synthesis Bool)
+ (case [analysis synthesis]
+ (^ [(^code []) (^code [])])
+ true
+
+ (^template [ ]
+ [[_ ( valueA)] [_ ( valueS)]]
+ ( valueA valueS))
+ ([#;Bool bool/=]
+ [#;Nat n.=]
+ [#;Int i.=]
+ [#;Deg d.=]
+ [#;Frac f.=]
+ [#;Text text/=])
+
+ _
+ false))
diff --git a/new-luxc/test/test/luxc/lang/synthesis/function.lux b/new-luxc/test/test/luxc/lang/synthesis/function.lux
new file mode 100644
index 000000000..f364536cb
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/synthesis/function.lux
@@ -0,0 +1,150 @@
+(;module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data [product]
+ [maybe]
+ [number]
+ text/format
+ (coll [list "list/" Functor Fold]
+ [dict #+ Dict]
+ [set]))
+ (meta [code])
+ ["r" math/random "r/" Monad]
+ test)
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ (synthesis [";S" expression])
+ [";L" variable #+ Variable]))
+ (.. common))
+
+(def: gen-function//constant
+ (r;Random [Nat la;Analysis la;Analysis])
+ (r;rec
+ (function [gen-function//constant]
+ (do r;Monad
+ [function? r;bool]
+ (if function?
+ (do @
+ [[num-args outputA subA] gen-function//constant]
+ (wrap [(n.inc num-args)
+ outputA
+ (` ("lux function" [] (~ subA)))]))
+ (do @
+ [outputA gen-primitive]
+ (wrap [+0 outputA outputA])))))))
+
+(def: (pick scope-size)
+ (-> Nat (r;Random Nat))
+ (|> r;nat (:: r;Monad map (n.% scope-size))))
+
+(def: gen-function//captured
+ (r;Random [Nat Int la;Analysis])
+ (do r;Monad
+ [num-locals (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ #let [indices (list;n.range +0 (n.dec num-locals))
+ absolute-env (list/map variableL;local indices)
+ relative-env (list/map variableL;captured indices)]
+ [total-args prediction bodyA] (: (r;Random [Nat Int la;Analysis])
+ (loop [num-args +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 Int)
+ (dict;new number;Hash))
+ (list;zip2 (list;n.range +0 (n.dec env-size))
+ global-env))]
+ (do @
+ [nest? r;bool]
+ (if nest?
+ (do @
+ [num-picks (:: @ map (n.max +1) (pick (n.inc env-size)))
+ picks (|> (r;set number;Hash num-picks (pick env-size))
+ (:: @ map set;to-list))
+ [total-args prediction bodyA] (recur (n.inc num-args)
+ (list/map (function [pick] (maybe;assume (list;nth pick global-env)))
+ picks))]
+ (wrap [total-args prediction (` ("lux function" [(~@ (list/map (|>. variableL;captured code;int) picks))]
+ (~ bodyA)))]))
+ (do @
+ [chosen (pick (list;size global-env))]
+ (wrap [num-args
+ (maybe;assume (dict;get chosen resolver))
+ (la;var (variableL;captured chosen))])))))))]
+ (wrap [total-args prediction (` ("lux function"
+ [(~@ (list/map code;int absolute-env))]
+ (~ bodyA)))])
+ ))
+
+(def: gen-function//local
+ (r;Random [Nat Int la;Analysis])
+ (loop [num-args +0
+ nest? true]
+ (if nest?
+ (do r;Monad
+ [nest?' r;bool
+ [total-args prediction bodyA] (recur (n.inc num-args) nest?')]
+ (wrap [total-args prediction (` ("lux function" [] (~ bodyA)))]))
+ (do r;Monad
+ [chosen (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))]
+ (wrap [num-args
+ (|> chosen (n.+ (n.dec num-args)) nat-to-int)
+ (la;var (variableL;local chosen))])))))
+
+(context: "Function definition."
+ (<| (times +100)
+ (do @
+ [[args1 prediction1 function1] gen-function//constant
+ [args2 prediction2 function2] gen-function//captured
+ [args3 prediction3 function3] gen-function//local]
+ ($_ seq
+ (test "Nested functions will get folded together."
+ (|> (expressionS;synthesize function1)
+ (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)] output))])
+ (and (n.= args1 args)
+ (corresponds? prediction1 output))
+
+ _
+ (n.= +0 args1))))
+ (test "Folded functions provide direct access to captured variables."
+ (|> (expressionS;synthesize function2)
+ (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)]
+ [_ (#;Form (list [_ (#;Int output)]))]))])
+ (and (n.= args2 args)
+ (i.= prediction2 output))
+
+ _
+ false)))
+ (test "Folded functions properly offset local variables."
+ (|> (expressionS;synthesize function3)
+ (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)]
+ [_ (#;Form (list [_ (#;Int output)]))]))])
+ (and (n.= args3 args)
+ (i.= prediction3 output))
+
+ _
+ false)))
+ ))))
+
+(context: "Function application."
+ (<| (times +100)
+ (do @
+ [num-args (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
+ funcA gen-primitive
+ argsA (r;list num-args gen-primitive)]
+ ($_ seq
+ (test "Can synthesize function application."
+ (|> (expressionS;synthesize (la;apply argsA funcA))
+ (case> (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
+ (and (corresponds? funcA funcS)
+ (list;every? (product;uncurry corresponds?)
+ (list;zip2 argsA argsS)))
+
+ _
+ false)))
+ (test "Function application on no arguments just synthesizes to the function itself."
+ (|> (expressionS;synthesize (la;apply (list) funcA))
+ (corresponds? funcA)))
+ ))))
diff --git a/new-luxc/test/test/luxc/lang/synthesis/loop.lux b/new-luxc/test/test/luxc/lang/synthesis/loop.lux
new file mode 100644
index 000000000..90b303857
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/synthesis/loop.lux
@@ -0,0 +1,159 @@
+(;module:
+ lux
+ (lux [io]
+ (control [monad #+ do])
+ (data [bool "bool/" Eq]
+ [number]
+ (coll [list "list/" Functor Fold]
+ ["s" set])
+ text/format)
+ (meta [code])
+ ["r" math/random "r/" Monad]
+ test)
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ (synthesis [";S" expression]
+ [";S" loop])))
+ (.. common))
+
+(def: (does-recursion? arity exprS)
+ (-> ls;Arity ls;Synthesis Bool)
+ (loop [exprS exprS]
+ (case exprS
+ (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
+ (loop [pathS pathS]
+ (case pathS
+ (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
+ (or (recur leftS)
+ (recur rightS))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])
+ (recur rightS)
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (does-recursion? arity bodyS)
+
+ _
+ false))
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
+ (n.= arity (list;size argsS))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
+ (recur bodyS)
+
+ (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (or (recur thenS)
+ (recur elseS))
+
+ _
+ false
+ )))
+
+(def: (gen-body arity output)
+ (-> Nat la;Analysis (r;Random la;Analysis))
+ (r;either (r;either (r/wrap output)
+ (do r;Monad
+ [inputA (|> r;nat (:: @ map code;nat))
+ num-cases (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
+ tests (|> (r;set number;Hash num-cases r;nat)
+ (:: @ map (|>. s;to-list (list/map code;nat))))
+ #let [bad-bodies (list;repeat num-cases (' []))]
+ good-body (gen-body arity output)
+ where-to-set (|> r;nat (:: @ map (n.% num-cases)))
+ #let [bodies (list;concat (list (list;take where-to-set bad-bodies)
+ (list good-body)
+ (list;drop (n.inc where-to-set) bad-bodies)))]]
+ (wrap (` ("lux case" (~ inputA)
+ (~ (code;record (list;zip2 tests bodies))))))))
+ (r;either (do r;Monad
+ [valueS r;bool
+ output' (gen-body (n.inc arity) output)]
+ (wrap (` ("lux case" (~ (code;bool valueS))
+ {("lux case bind" (~ (code;nat arity))) (~ output')}))))
+ (do r;Monad
+ [valueS r;bool
+ then|else r;bool
+ output' (gen-body arity output)
+ #let [thenA (if then|else output' (' []))
+ elseA (if (not then|else) output' (' []))]]
+ (wrap (` ("lux case" (~ (code;bool valueS))
+ {(~ (code;bool then|else)) (~ thenA)
+ (~ (code;bool (not then|else))) (~ elseA)})))))
+ ))
+
+(def: (make-function arity body)
+ (-> ls;Arity la;Analysis la;Analysis)
+ (case arity
+ +0 body
+ _ (` ("lux function" [] (~ (make-function (n.dec arity) body))))))
+
+(def: gen-recursion
+ (r;Random [Bool Nat la;Analysis])
+ (do r;Monad
+ [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
+ recur? r;bool
+ outputS (if recur?
+ (wrap (la;apply (list;repeat arity (' [])) (la;var 0)))
+ (do @
+ [plus-or-minus? r;bool
+ how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1))))
+ #let [shift (if plus-or-minus? n.+ n.-)]]
+ (wrap (la;apply (list;repeat (shift how-much arity) (' [])) (la;var 0)))))
+ bodyS (gen-body arity outputS)]
+ (wrap [recur? arity (make-function arity bodyS)])))
+
+(def: gen-loop
+ (r;Random [Bool Nat la;Analysis])
+ (do r;Monad
+ [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
+ recur? r;bool
+ self-ref? r;bool
+ #let [selfA (la;var 0)
+ argA (if self-ref? selfA (' []))]
+ outputS (if recur?
+ (wrap (la;apply (list;repeat arity argA) selfA))
+ (do @
+ [plus-or-minus? r;bool
+ how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1))))
+ #let [shift (if plus-or-minus? n.+ n.-)]]
+ (wrap (la;apply (list;repeat (shift how-much arity) (' [])) selfA))))
+ bodyS (gen-body arity outputS)]
+ (wrap [(and recur? (not self-ref?))
+ arity
+ (make-function arity bodyS)])))
+
+(context: "Recursion."
+ (<| (times +100)
+ (do @
+ [[prediction arity analysis] gen-recursion]
+ ($_ seq
+ (test "Can accurately identify (and then reify) tail recursion."
+ (case (expressionS;synthesize analysis)
+ (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _body))])
+ (|> _body
+ (does-recursion? arity)
+ (bool/= prediction)
+ (and (n.= arity _arity)))
+
+ _
+ false))))))
+
+(context: "Loop."
+ (<| (times +100)
+ (do @
+ [[prediction arity analysis] gen-recursion]
+ ($_ seq
+ (test "Can reify loops."
+ (case (expressionS;synthesize (la;apply (list;repeat arity (' [])) analysis))
+ (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat in_register)] [_ (#;Tuple _inits)] _body))])
+ (and (n.= arity (list;size _inits))
+ (not (loopS;contains-self-reference? _body)))
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux call")]
+ [_ (#;Form (list [_ (#;Text "lux function")] _arity _env _bodyS))]
+ argsS))])
+ (loopS;contains-self-reference? _bodyS)
+
+ _
+ false))))))
diff --git a/new-luxc/test/test/luxc/lang/synthesis/primitive.lux b/new-luxc/test/test/luxc/lang/synthesis/primitive.lux
new file mode 100644
index 000000000..d907a4c04
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/synthesis/primitive.lux
@@ -0,0 +1,45 @@
+(;module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data text/format)
+ (meta [code])
+ ["r" math/random]
+ test)
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ (synthesis [";S" expression]))))
+
+(context: "Primitives"
+ (<| (times +100)
+ (do @
+ [%bool% r;bool
+ %nat% r;nat
+ %int% r;int
+ %deg% r;deg
+ %frac% r;frac
+ %text% (r;text +5)]
+ (`` ($_ seq
+ (test (format "Can synthesize unit.")
+ (|> (expressionS;synthesize (' []))
+ (case> (^code [])
+ true
+
+ _
+ false)))
+ (~~ (do-template [ ]
+ [(test (format "Can synthesize " ".")
+ (|> (expressionS;synthesize ( ))
+ (case> [_ ( value)]
+ (is value)
+
+ _
+ false)))]
+
+ ["bool" code;bool #;Bool %bool%]
+ ["nat" code;nat #;Nat %nat%]
+ ["int" code;int #;Int %int%]
+ ["deg" code;deg #;Deg %deg%]
+ ["frac" code;frac #;Frac %frac%]
+ ["text" code;text #;Text %text%])))))))
diff --git a/new-luxc/test/test/luxc/lang/synthesis/procedure.lux b/new-luxc/test/test/luxc/lang/synthesis/procedure.lux
new file mode 100644
index 000000000..2263a1616
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/synthesis/procedure.lux
@@ -0,0 +1,32 @@
+(;module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data [text "text/" Eq]
+ [product]
+ (coll [list]))
+ ["r" math/random "r/" Monad]
+ test)
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ (synthesis [";S" expression])))
+ (.. common))
+
+(context: "Procedures"
+ (<| (times +100)
+ (do @
+ [num-args (|> r;nat (:: @ map (n.% +10)))
+ nameA (r;text +5)
+ argsA (r;list num-args gen-primitive)]
+ ($_ seq
+ (test "Can synthesize procedure calls."
+ (|> (expressionS;synthesize (la;procedure nameA argsA))
+ (case> (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
+ (and (text/= nameA procedure)
+ (list;every? (product;uncurry corresponds?)
+ (list;zip2 argsA argsS)))
+
+ _
+ false)))
+ ))))
diff --git a/new-luxc/test/test/luxc/lang/synthesis/structure.lux b/new-luxc/test/test/luxc/lang/synthesis/structure.lux
new file mode 100644
index 000000000..eab568bbe
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/synthesis/structure.lux
@@ -0,0 +1,49 @@
+(;module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data [bool "B/" Eq]
+ [product]
+ (coll [list]))
+ ["r" math/random "r/" Monad]
+ test)
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ (synthesis [";S" expression])))
+ (.. common))
+
+(context: "Variants"
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ tagA (|> r;nat (:: @ map (n.% size)))
+ memberA gen-primitive]
+ ($_ seq
+ (test "Can synthesize variants."
+ (|> (expressionS;synthesize (la;sum tagA size +0 memberA))
+ (case> (^ [_ (#;Form (list [_ (#;Nat tagS)] [_ (#;Bool last?S)] memberS))])
+ (and (n.= tagA tagS)
+ (B/= (n.= (n.dec size) tagA)
+ last?S)
+ (corresponds? memberA memberS))
+
+ _
+ false)))
+ ))))
+
+(context: "Tuples"
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ membersA (r;list size gen-primitive)]
+ ($_ seq
+ (test "Can synthesize tuple."
+ (|> (expressionS;synthesize (la;product membersA))
+ (case> [_ (#;Tuple membersS)]
+ (and (n.= size (list;size membersS))
+ (list;every? (product;uncurry corresponds?) (list;zip2 membersA membersS)))
+
+ _
+ false)))
+ ))))
diff --git a/new-luxc/test/test/luxc/synthesizer/case/special.lux b/new-luxc/test/test/luxc/synthesizer/case/special.lux
deleted file mode 100644
index 30e64fc77..000000000
--- a/new-luxc/test/test/luxc/synthesizer/case/special.lux
+++ /dev/null
@@ -1,68 +0,0 @@
-(;module:
- lux
- (lux [io]
- (control [monad #+ do]
- pipe)
- (meta [code])
- ["r" math/random "r/" Monad]
- test)
- (luxc (lang ["la" analysis]
- ["ls" synthesis]
- [";L" variable #+ Variable])
- [synthesizer])
- (../.. 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."
- (|> (synthesizer;synthesize 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."
- (|> (synthesizer;synthesize 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."
- (|> (synthesizer;synthesize ifA)
- (case> (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
- (and (corresponds? inputA inputS)
- (corresponds? thenA thenS)
- (corresponds? elseA elseS))
-
- _
- false))))))
diff --git a/new-luxc/test/test/luxc/synthesizer/common.lux b/new-luxc/test/test/luxc/synthesizer/common.lux
deleted file mode 100644
index a74c64402..000000000
--- a/new-luxc/test/test/luxc/synthesizer/common.lux
+++ /dev/null
@@ -1,37 +0,0 @@
-(;module:
- lux
- (lux (data [bool "bool/" Eq]
- [text "text/" Eq])
- (meta [code])
- ["r" math/random "r/" Monad])
- (luxc (lang ["la" analysis]
- ["ls" synthesis])))
-
-(def: #export gen-primitive
- (r;Random la;Analysis)
- (r;either (r;either (r;either (r/wrap (' []))
- (r/map code;bool r;bool))
- (r;either (r/map code;nat r;nat)
- (r/map code;int r;int)))
- (r;either (r;either (r/map code;deg r;deg)
- (r/map code;frac r;frac))
- (r/map code;text (r;text +5)))))
-
-(def: #export (corresponds? analysis synthesis)
- (-> la;Analysis ls;Synthesis Bool)
- (case [analysis synthesis]
- (^ [(^code []) (^code [])])
- true
-
- (^template [ ]
- [[_ ( valueA)] [_ ( valueS)]]
- ( valueA valueS))
- ([#;Bool bool/=]
- [#;Nat n.=]
- [#;Int i.=]
- [#;Deg d.=]
- [#;Frac f.=]
- [#;Text text/=])
-
- _
- false))
diff --git a/new-luxc/test/test/luxc/synthesizer/function.lux b/new-luxc/test/test/luxc/synthesizer/function.lux
deleted file mode 100644
index cab0da847..000000000
--- a/new-luxc/test/test/luxc/synthesizer/function.lux
+++ /dev/null
@@ -1,150 +0,0 @@
-(;module:
- lux
- (lux [io]
- (control [monad #+ do]
- pipe)
- (data [product]
- [maybe]
- [number]
- text/format
- (coll [list "list/" Functor Fold]
- [dict #+ Dict]
- [set]))
- (meta [code])
- ["r" math/random "r/" Monad]
- test)
- (luxc (lang ["la" analysis]
- ["ls" synthesis]
- [";L" variable #+ Variable])
- [synthesizer])
- (.. common))
-
-(def: gen-function//constant
- (r;Random [Nat la;Analysis la;Analysis])
- (r;rec
- (function [gen-function//constant]
- (do r;Monad
- [function? r;bool]
- (if function?
- (do @
- [[num-args outputA subA] gen-function//constant]
- (wrap [(n.inc num-args)
- outputA
- (` ("lux function" [] (~ subA)))]))
- (do @
- [outputA gen-primitive]
- (wrap [+0 outputA outputA])))))))
-
-(def: (pick scope-size)
- (-> Nat (r;Random Nat))
- (|> r;nat (:: r;Monad map (n.% scope-size))))
-
-(def: gen-function//captured
- (r;Random [Nat Int la;Analysis])
- (do r;Monad
- [num-locals (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
- #let [indices (list;n.range +0 (n.dec num-locals))
- absolute-env (list/map variableL;local indices)
- relative-env (list/map variableL;captured indices)]
- [total-args prediction bodyA] (: (r;Random [Nat Int la;Analysis])
- (loop [num-args +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 Int)
- (dict;new number;Hash))
- (list;zip2 (list;n.range +0 (n.dec env-size))
- global-env))]
- (do @
- [nest? r;bool]
- (if nest?
- (do @
- [num-picks (:: @ map (n.max +1) (pick (n.inc env-size)))
- picks (|> (r;set number;Hash num-picks (pick env-size))
- (:: @ map set;to-list))
- [total-args prediction bodyA] (recur (n.inc num-args)
- (list/map (function [pick] (maybe;assume (list;nth pick global-env)))
- picks))]
- (wrap [total-args prediction (` ("lux function" [(~@ (list/map (|>. variableL;captured code;int) picks))]
- (~ bodyA)))]))
- (do @
- [chosen (pick (list;size global-env))]
- (wrap [num-args
- (maybe;assume (dict;get chosen resolver))
- (la;var (variableL;captured chosen))])))))))]
- (wrap [total-args prediction (` ("lux function"
- [(~@ (list/map code;int absolute-env))]
- (~ bodyA)))])
- ))
-
-(def: gen-function//local
- (r;Random [Nat Int la;Analysis])
- (loop [num-args +0
- nest? true]
- (if nest?
- (do r;Monad
- [nest?' r;bool
- [total-args prediction bodyA] (recur (n.inc num-args) nest?')]
- (wrap [total-args prediction (` ("lux function" [] (~ bodyA)))]))
- (do r;Monad
- [chosen (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))]
- (wrap [num-args
- (|> chosen (n.+ (n.dec num-args)) nat-to-int)
- (la;var (variableL;local chosen))])))))
-
-(context: "Function definition."
- (<| (times +100)
- (do @
- [[args1 prediction1 function1] gen-function//constant
- [args2 prediction2 function2] gen-function//captured
- [args3 prediction3 function3] gen-function//local]
- ($_ seq
- (test "Nested functions will get folded together."
- (|> (synthesizer;synthesize function1)
- (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)] output))])
- (and (n.= args1 args)
- (corresponds? prediction1 output))
-
- _
- (n.= +0 args1))))
- (test "Folded functions provide direct access to captured variables."
- (|> (synthesizer;synthesize function2)
- (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)]
- [_ (#;Form (list [_ (#;Int output)]))]))])
- (and (n.= args2 args)
- (i.= prediction2 output))
-
- _
- false)))
- (test "Folded functions properly offset local variables."
- (|> (synthesizer;synthesize function3)
- (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)]
- [_ (#;Form (list [_ (#;Int output)]))]))])
- (and (n.= args3 args)
- (i.= prediction3 output))
-
- _
- false)))
- ))))
-
-(context: "Function application."
- (<| (times +100)
- (do @
- [num-args (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
- funcA gen-primitive
- argsA (r;list num-args gen-primitive)]
- ($_ seq
- (test "Can synthesize function application."
- (|> (synthesizer;synthesize (la;apply argsA funcA))
- (case> (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
- (and (corresponds? funcA funcS)
- (list;every? (product;uncurry corresponds?)
- (list;zip2 argsA argsS)))
-
- _
- false)))
- (test "Function application on no arguments just synthesizes to the function itself."
- (|> (synthesizer;synthesize (la;apply (list) funcA))
- (corresponds? funcA)))
- ))))
diff --git a/new-luxc/test/test/luxc/synthesizer/loop.lux b/new-luxc/test/test/luxc/synthesizer/loop.lux
deleted file mode 100644
index fd8c95ce1..000000000
--- a/new-luxc/test/test/luxc/synthesizer/loop.lux
+++ /dev/null
@@ -1,159 +0,0 @@
-(;module:
- lux
- (lux [io]
- (control [monad #+ do])
- (data [bool "bool/" Eq]
- [number]
- (coll [list "list/" Functor Fold]
- ["s" set])
- text/format)
- (meta [code])
- ["r" math/random "r/" Monad]
- test)
- (luxc (lang ["la" analysis]
- ["ls" synthesis])
- [synthesizer]
- (synthesizer ["&&;" loop]))
- (.. common))
-
-(def: (does-recursion? arity exprS)
- (-> ls;Arity ls;Synthesis Bool)
- (loop [exprS exprS]
- (case exprS
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
- (loop [pathS pathS]
- (case pathS
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
- (or (recur leftS)
- (recur rightS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])
- (recur rightS)
-
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (does-recursion? arity bodyS)
-
- _
- false))
-
- (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
- (n.= arity (list;size argsS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
- (recur bodyS)
-
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
- (or (recur thenS)
- (recur elseS))
-
- _
- false
- )))
-
-(def: (gen-body arity output)
- (-> Nat la;Analysis (r;Random la;Analysis))
- (r;either (r;either (r/wrap output)
- (do r;Monad
- [inputA (|> r;nat (:: @ map code;nat))
- num-cases (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
- tests (|> (r;set number;Hash num-cases r;nat)
- (:: @ map (|>. s;to-list (list/map code;nat))))
- #let [bad-bodies (list;repeat num-cases (' []))]
- good-body (gen-body arity output)
- where-to-set (|> r;nat (:: @ map (n.% num-cases)))
- #let [bodies (list;concat (list (list;take where-to-set bad-bodies)
- (list good-body)
- (list;drop (n.inc where-to-set) bad-bodies)))]]
- (wrap (` ("lux case" (~ inputA)
- (~ (code;record (list;zip2 tests bodies))))))))
- (r;either (do r;Monad
- [valueS r;bool
- output' (gen-body (n.inc arity) output)]
- (wrap (` ("lux case" (~ (code;bool valueS))
- {("lux case bind" (~ (code;nat arity))) (~ output')}))))
- (do r;Monad
- [valueS r;bool
- then|else r;bool
- output' (gen-body arity output)
- #let [thenA (if then|else output' (' []))
- elseA (if (not then|else) output' (' []))]]
- (wrap (` ("lux case" (~ (code;bool valueS))
- {(~ (code;bool then|else)) (~ thenA)
- (~ (code;bool (not then|else))) (~ elseA)})))))
- ))
-
-(def: (make-function arity body)
- (-> ls;Arity la;Analysis la;Analysis)
- (case arity
- +0 body
- _ (` ("lux function" [] (~ (make-function (n.dec arity) body))))))
-
-(def: gen-recursion
- (r;Random [Bool Nat la;Analysis])
- (do r;Monad
- [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
- recur? r;bool
- outputS (if recur?
- (wrap (la;apply (list;repeat arity (' [])) (la;var 0)))
- (do @
- [plus-or-minus? r;bool
- how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1))))
- #let [shift (if plus-or-minus? n.+ n.-)]]
- (wrap (la;apply (list;repeat (shift how-much arity) (' [])) (la;var 0)))))
- bodyS (gen-body arity outputS)]
- (wrap [recur? arity (make-function arity bodyS)])))
-
-(def: gen-loop
- (r;Random [Bool Nat la;Analysis])
- (do r;Monad
- [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
- recur? r;bool
- self-ref? r;bool
- #let [selfA (la;var 0)
- argA (if self-ref? selfA (' []))]
- outputS (if recur?
- (wrap (la;apply (list;repeat arity argA) selfA))
- (do @
- [plus-or-minus? r;bool
- how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1))))
- #let [shift (if plus-or-minus? n.+ n.-)]]
- (wrap (la;apply (list;repeat (shift how-much arity) (' [])) selfA))))
- bodyS (gen-body arity outputS)]
- (wrap [(and recur? (not self-ref?))
- arity
- (make-function arity bodyS)])))
-
-(context: "Recursion."
- (<| (times +100)
- (do @
- [[prediction arity analysis] gen-recursion]
- ($_ seq
- (test "Can accurately identify (and then reify) tail recursion."
- (case (synthesizer;synthesize analysis)
- (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _body))])
- (|> _body
- (does-recursion? arity)
- (bool/= prediction)
- (and (n.= arity _arity)))
-
- _
- false))))))
-
-(context: "Loop."
- (<| (times +100)
- (do @
- [[prediction arity analysis] gen-recursion]
- ($_ seq
- (test "Can reify loops."
- (case (synthesizer;synthesize (la;apply (list;repeat arity (' [])) analysis))
- (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat in_register)] [_ (#;Tuple _inits)] _body))])
- (and (n.= arity (list;size _inits))
- (not (&&loop;contains-self-reference? _body)))
-
- (^ [_ (#;Form (list& [_ (#;Text "lux call")]
- [_ (#;Form (list [_ (#;Text "lux function")] _arity _env _bodyS))]
- argsS))])
- (&&loop;contains-self-reference? _bodyS)
-
- _
- false))))))
diff --git a/new-luxc/test/test/luxc/synthesizer/primitive.lux b/new-luxc/test/test/luxc/synthesizer/primitive.lux
deleted file mode 100644
index 2a1490193..000000000
--- a/new-luxc/test/test/luxc/synthesizer/primitive.lux
+++ /dev/null
@@ -1,45 +0,0 @@
-(;module:
- lux
- (lux [io]
- (control [monad #+ do]
- pipe)
- (data text/format)
- (meta [code])
- ["r" math/random]
- test)
- (luxc (lang ["la" analysis]
- ["ls" synthesis])
- [synthesizer]))
-
-(context: "Primitives"
- (<| (times +100)
- (do @
- [%bool% r;bool
- %nat% r;nat
- %int% r;int
- %deg% r;deg
- %frac% r;frac
- %text% (r;text +5)]
- (`` ($_ seq
- (test (format "Can synthesize unit.")
- (|> (synthesizer;synthesize (' []))
- (case> (^code [])
- true
-
- _
- false)))
- (~~ (do-template [ ]
- [(test (format "Can synthesize " ".")
- (|> (synthesizer;synthesize ( ))
- (case> [_ ( value)]
- (is value)
-
- _
- false)))]
-
- ["bool" code;bool #;Bool %bool%]
- ["nat" code;nat #;Nat %nat%]
- ["int" code;int #;Int %int%]
- ["deg" code;deg #;Deg %deg%]
- ["frac" code;frac #;Frac %frac%]
- ["text" code;text #;Text %text%])))))))
diff --git a/new-luxc/test/test/luxc/synthesizer/procedure.lux b/new-luxc/test/test/luxc/synthesizer/procedure.lux
deleted file mode 100644
index c659c5e34..000000000
--- a/new-luxc/test/test/luxc/synthesizer/procedure.lux
+++ /dev/null
@@ -1,32 +0,0 @@
-(;module:
- lux
- (lux [io]
- (control [monad #+ do]
- pipe)
- (data [text "text/" Eq]
- [product]
- (coll [list]))
- ["r" math/random "r/" Monad]
- test)
- (luxc (lang ["la" analysis]
- ["ls" synthesis])
- [synthesizer])
- (.. common))
-
-(context: "Procedures"
- (<| (times +100)
- (do @
- [num-args (|> r;nat (:: @ map (n.% +10)))
- nameA (r;text +5)
- argsA (r;list num-args gen-primitive)]
- ($_ seq
- (test "Can synthesize procedure calls."
- (|> (synthesizer;synthesize (la;procedure nameA argsA))
- (case> (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
- (and (text/= nameA procedure)
- (list;every? (product;uncurry corresponds?)
- (list;zip2 argsA argsS)))
-
- _
- false)))
- ))))
diff --git a/new-luxc/test/test/luxc/synthesizer/structure.lux b/new-luxc/test/test/luxc/synthesizer/structure.lux
deleted file mode 100644
index 517f087d1..000000000
--- a/new-luxc/test/test/luxc/synthesizer/structure.lux
+++ /dev/null
@@ -1,49 +0,0 @@
-(;module:
- lux
- (lux [io]
- (control [monad #+ do]
- pipe)
- (data [bool "B/" Eq]
- [product]
- (coll [list]))
- ["r" math/random "r/" Monad]
- test)
- (luxc (lang ["la" analysis]
- ["ls" synthesis])
- [synthesizer])
- (.. common))
-
-(context: "Variants"
- (<| (times +100)
- (do @
- [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
- tagA (|> r;nat (:: @ map (n.% size)))
- memberA gen-primitive]
- ($_ seq
- (test "Can synthesize variants."
- (|> (synthesizer;synthesize (la;sum tagA size +0 memberA))
- (case> (^ [_ (#;Form (list [_ (#;Nat tagS)] [_ (#;Bool last?S)] memberS))])
- (and (n.= tagA tagS)
- (B/= (n.= (n.dec size) tagA)
- last?S)
- (corresponds? memberA memberS))
-
- _
- false)))
- ))))
-
-(context: "Tuples"
- (<| (times +100)
- (do @
- [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
- membersA (r;list size gen-primitive)]
- ($_ seq
- (test "Can synthesize tuple."
- (|> (synthesizer;synthesize (la;product membersA))
- (case> [_ (#;Tuple membersS)]
- (and (n.= size (list;size membersS))
- (list;every? (product;uncurry corresponds?) (list;zip2 membersA membersS)))
-
- _
- false)))
- ))))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index f96d5bdfc..5ec79d1e5 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -13,13 +13,13 @@
["_;A" function]
["_;A" type]
(procedure ["_;A" common]
- ["_;A" host])))
- (synthesizer ["_;S" primitive]
- ["_;S" structure]
- (case ["_;S" special])
- ["_;S" function]
- ["_;S" procedure]
- ["_;S" loop])
+ ["_;A" host]))
+ (synthesis ["_;S" primitive]
+ ["_;S" structure]
+ (case ["_;S" special])
+ ["_;S" function]
+ ["_;S" procedure]
+ ["_;S" loop]))
(generator ["_;G" primitive]
["_;G" structure]
["_;G" case]
--
cgit v1.2.3