diff options
Diffstat (limited to 'new-luxc')
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/expression.lux | 202 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/function.lux | 29 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/loop.lux | 188 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/synthesis/case/special.lux | 72 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/synthesis/common.lux | 37 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/synthesis/function.lux | 151 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/synthesis/primitive.lux | 46 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/synthesis/structure.lux | 50 |
8 files changed, 0 insertions, 775 deletions
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux deleted file mode 100644 index 3fa594086..000000000 --- a/new-luxc/source/luxc/lang/synthesis/expression.lux +++ /dev/null @@ -1,202 +0,0 @@ -(.module: - lux - (lux (control ["p" parser]) - (data [maybe] - ["e" error] - [number] - [product] - text/format - (coll [list "list/" Functor<List> Fold<List> Monoid<List>] - (dictionary ["dict" unordered #+ Dict]))) - (macro [code] - ["s" syntax])) - (luxc (lang ["la" analysis] - ["ls" synthesis] - [".L" extension #+ Syntheses] - (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<Int>)) - -(def: (prepare-body inner-arity arity body) - (-> ls.Arity ls.Arity 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 arity num-locals synthesize inputA branchesA) - (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis) - la.Analysis (List [la.Pattern la.Analysis]) - ls.Synthesis) - (let [inputS (synthesize num-locals inputA)] - (case (list.reverse branchesA) - (^multi (^ (list [(^code ("lux case bind" (~ [_ (#.Nat input-register)]))) - (^code ((~ [_ (#.Int var)])))])) - (not (variableL.captured? var)) - (n/= input-register (variableL.local-register var))) - inputS - - (^ (list [(^code ("lux case bind" (~ [_ (#.Nat register)]))) bodyA])) - (let$ (if (functionS.nested? arity) - (n/+ (n/dec arity) register) - register) - inputS - (synthesize (n/inc num-locals) bodyA)) - - (^or (^ (list [(^code true) thenA] [(^code false) elseA])) - (^ (list [(^code false) elseA] [(^code true) thenA]))) - (if$ inputS (synthesize num-locals thenA) (synthesize num-locals elseA)) - - (#.Cons [lastP lastA] prevsPA) - (let [transform-branch (: (-> la.Pattern la.Analysis ls.Path) - (caseS.path arity num-locals synthesize)) - pathS (list/fold caseS.weave - (transform-branch lastP lastA) - (list/map (product.uncurry transform-branch) prevsPA))] - (` ("lux case" (~ inputS) (~ pathS)))) - - _ - (undefined) - ))) - -(def: (synthesize-apply synthesize num-locals exprA) - (-> (-> la.Analysis ls.Synthesis) Nat la.Analysis ls.Synthesis) - (let [[funcA argsA] (functionS.unfold-apply exprA) - funcS (synthesize funcA) - argsS (list/map synthesize argsA)] - (case funcS - (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~+ _env)] (~ _bodyS))) - (and (n/= _arity (list.size argsS)) - (not (loopS.contains-self-reference? _bodyS))) - [(s.run _env (p.some s.int)) (#e.Success _env)]) - (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~+ argsS)] - (~ (loopS.adjust _env num-locals _bodyS)))) - - (^code ("lux call" (~ funcS') (~+ argsS'))) - (call$ funcS' (list/compose argsS' argsS)) - - _ - (call$ funcS argsS)))) - -(def: #export (synthesize extensions expressionA) - (-> Syntheses la.Analysis ls.Synthesis) - (loop [arity +0 - resolver init-resolver - direct? false - num-locals +0 - expressionA expressionA] - (case expressionA - (^code [(~ _left) (~ _right)]) - (` [(~+ (list/map (recur arity resolver false num-locals) - (la.unfold-tuple expressionA)))]) - - (^or (^code ("lux sum left" (~ _))) - (^code ("lux sum right" (~ _)))) - (let [[tag last? value] (maybe.assume (la.unfold-variant expressionA))] - (variant$ tag last? (recur arity resolver false num-locals value))) - - (^code ((~ [_ (#.Int var)]))) - (if (variableL.local? var) - (if (functionS.nested? arity) - (if (variableL.self? var) - (call$ (var$ 0) (|> (list.n/range +1 (n/dec arity)) - (list/map (|>> variableL.local code.int (~) () (`))))) - (var$ (functionS.adjust-var arity var))) - (var$ var)) - (var$ (maybe.default var (dict.get var resolver)))) - - (^code ("lux case" (~ inputA) (~ [_ (#.Record branchesA)]))) - (synthesize-case arity num-locals (recur arity resolver false) inputA branchesA) - - (^multi (^code ("lux function" [(~+ scope)] (~ bodyA))) - [(s.run scope (p.some s.int)) (#e.Success raw-env)]) - (let [function-arity (if direct? - (n/inc arity) - +1) - env (list/map (function (_ closure) - (case (dict.get closure resolver) - (#.Some resolved) - (if (and (variableL.local? resolved) - (functionS.nested? arity) - (|> resolved variableL.local-register (n/>= arity))) - (functionS.adjust-var arity resolved) - resolved) - - #.None - (if (and (variableL.local? closure) - (functionS.nested? arity)) - (functionS.adjust-var arity closure) - closure))) - raw-env) - env-vars (: (List Variable) - (case raw-env - #.Nil (list) - _ (|> (list.size raw-env) n/dec (list.n/range +0) (list/map variableL.captured)))) - resolver' (if (and (functionS.nested? function-arity) - direct?) - (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 function-arity resolver' true function-arity bodyA) - (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat unmerged-arity)] env' bodyS'))]) - (let [merged-arity (n/inc unmerged-arity)] - (function$ merged-arity env - (prepare-body function-arity merged-arity bodyS'))) - - bodyS - (function$ +1 env (prepare-body function-arity +1 bodyS)))) - - (^code ("lux apply" (~+ _))) - (synthesize-apply (recur arity resolver false num-locals) num-locals expressionA) - - (^code ((~ [_ (#.Text name)]) (~+ args))) - (case (dict.get name extensions) - #.None - (procedure$ name (list/map (recur arity resolver false num-locals) args)) - - (#.Some extension) - (extension (recur arity resolver false num-locals) args)) - - _ - expressionA))) diff --git a/new-luxc/source/luxc/lang/synthesis/function.lux b/new-luxc/source/luxc/lang/synthesis/function.lux deleted file mode 100644 index 25dd75aff..000000000 --- a/new-luxc/source/luxc/lang/synthesis/function.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - lux - (luxc (lang ["la" analysis] - ["ls" synthesis] - [".L" variable #+ Variable]))) - -(do-template [<name> <comp> <ref>] - [(def: #export (<name> arity) - (-> ls.Arity Bool) - (<comp> <ref> 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 deleted file mode 100644 index c00d5626b..000000000 --- a/new-luxc/source/luxc/lang/synthesis/loop.lux +++ /dev/null @@ -1,188 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["p" parser]) - (data [maybe] - (coll [list "list/" Functor<List>])) - (macro [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 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 - (^code ((~ [_ (#.Nat tag)]) (~ last?) (~ valueS))) - (` ((~ (code.nat tag)) (~ last?) (~ (recur valueS)))) - - (^code [(~+ members)]) - (` [(~+ (list/map recur members))]) - - (^code ("lux case" (~ inputS) (~ pathS))) - (` ("lux case" (~ (recur inputS)) - (~ (let [adjust' recur] - (loop [pathS pathS] - (case pathS - (^template [<pattern>] - (^ [_ (#.Form (list [_ (#.Text <pattern>)] leftS rightS))]) - (` (<pattern> (~ (recur leftS)) (~ (recur rightS))))) - (["lux case alt"] - ["lux case seq"]) - - (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (` ("lux case bind" (~ (code.nat (n/+ offset register))))) - - (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))]) - (` ("lux case exec" (~ (adjust' bodyS)))) - - _ - pathS)))))) - - (^code ("lux function" (~ arity) [(~+ environment)] (~ bodyS))) - (` ("lux function" (~ arity) - [(~+ (list/map (function (_ _var) - (case _var - (^ [_ (#.Form (list [_ (#.Int var)]))]) - (` ((~ (code.int (resolve-captured var))))) - - _ - _var)) - environment))] - (~ 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)))) - - (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ bodyS))) - (` ("lux let" (~ (code.nat (n/+ 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 loop-offset)] [_ (#.Tuple initsS)] bodyS))]) - (` ("lux loop" (~ (code.nat (n/+ offset loop-offset))) - [(~+ (list/map recur initsS))] - (~ (recur bodyS)))) - - (^ [_ (#.Form (list [_ (#.Int var)]))]) - (if (variableL.captured? var) - (` ((~ (code.int (resolve-captured var))))) - (` ((~ (code.int (|> offset nat-to-int (i/+ var))))))) - - (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))]) - (` ((~ (code.text procedure)) (~+ (list/map recur argsS)))) - - _ - exprS - )))) diff --git a/new-luxc/test/test/luxc/lang/synthesis/case/special.lux b/new-luxc/test/test/luxc/lang/synthesis/case/special.lux deleted file mode 100644 index 398f98a57..000000000 --- a/new-luxc/test/test/luxc/lang/synthesis/case/special.lux +++ /dev/null @@ -1,72 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (macro [code]) - ["r" math/random "r/" Monad<Random>] - test) - (luxc (lang ["la" analysis] - ["ls" 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." - (|> (expressionS.synthesize 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." - (|> (expressionS.synthesize 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." - (|> (expressionS.synthesize 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/new-luxc/test/test/luxc/lang/synthesis/common.lux b/new-luxc/test/test/luxc/lang/synthesis/common.lux deleted file mode 100644 index 3379fe7fd..000000000 --- a/new-luxc/test/test/luxc/lang/synthesis/common.lux +++ /dev/null @@ -1,37 +0,0 @@ -(.module: - lux - (lux (data [bool "bool/" Eq<Bool>] - [text "text/" Eq<Text>]) - (macro [code]) - ["r" math/random "r/" Monad<Random>]) - (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 [<tag> <test>] - [[_ (<tag> valueA)] [_ (<tag> valueS)]] - (<test> 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 deleted file mode 100644 index fa29b4284..000000000 --- a/new-luxc/test/test/luxc/lang/synthesis/function.lux +++ /dev/null @@ -1,151 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data [product] - [maybe] - [number] - text/format - (coll [list "list/" Functor<List> Fold<List>] - (dictionary ["dict" unordered #+ Dict]) - (set ["set" unordered]))) - (macro [code]) - ["r" math/random "r/" Monad<Random>] - test) - (luxc (lang ["la" analysis] - ["ls" synthesis] - (synthesis [".S" expression]) - [".L" extension] - [".L" variable #+ Variable])) - (// common)) - -(def: gen-function//constant - (r.Random [Nat la.Analysis la.Analysis]) - (r.rec - (function (_ gen-function//constant) - (do r.Monad<Random> - [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<Random> map (n/% scope-size)))) - -(def: gen-function//captured - (r.Random [Nat Int la.Analysis]) - (do r.Monad<Random> - [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<Nat>)) - (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<Nat> 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<Random> - [nest?' r.bool - [total-args prediction bodyA] (recur (n/inc num-args) nest?')] - (wrap [total-args prediction (` ("lux function" [] (~ bodyA)))])) - (do r.Monad<Random> - [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 extensionL.no-syntheses 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 extensionL.no-syntheses 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 extensionL.no-syntheses 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 extensionL.no-syntheses (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 extensionL.no-syntheses (la.apply (list) funcA)) - (corresponds? funcA))) - )))) diff --git a/new-luxc/test/test/luxc/lang/synthesis/primitive.lux b/new-luxc/test/test/luxc/lang/synthesis/primitive.lux deleted file mode 100644 index d2298193f..000000000 --- a/new-luxc/test/test/luxc/lang/synthesis/primitive.lux +++ /dev/null @@ -1,46 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data text/format) - (macro [code]) - ["r" math/random] - test) - (luxc (lang ["la" analysis] - ["ls" synthesis] - [".L" extension] - (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 extensionL.no-syntheses (' [])) - (case> (^code []) - true - - _ - false))) - (~~ (do-template [<desc> <analysis> <synthesis> <sample>] - [(test (format "Can synthesize " <desc> ".") - (|> (expressionS.synthesize extensionL.no-syntheses (<analysis> <sample>)) - (case> [_ (<synthesis> value)] - (is? <sample> 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/structure.lux b/new-luxc/test/test/luxc/lang/synthesis/structure.lux deleted file mode 100644 index 46c9bf2a1..000000000 --- a/new-luxc/test/test/luxc/lang/synthesis/structure.lux +++ /dev/null @@ -1,50 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data [bool "B/" Eq<Bool>] - [product] - (coll [list])) - ["r" math/random "r/" Monad<Random>] - test) - (luxc (lang ["la" analysis] - ["ls" synthesis] - (synthesis [".S" expression]) - [".L" extension])) - (// 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 extensionL.no-syntheses (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 extensionL.no-syntheses (la.product membersA)) - (case> [_ (#.Tuple membersS)] - (and (n/= size (list.size membersS)) - (list.every? (product.uncurry corresponds?) (list.zip2 membersA membersS))) - - _ - false))) - )))) |