diff options
Diffstat (limited to '')
12 files changed, 472 insertions, 460 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index bad2e5500..99276bcf1 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -81,9 +81,7 @@ ## ["._" multi]]] ## [text ## ["._" buffer]]] - ## ["._" macro - ## [poly - ## ["._" json]]] + ## ["._" macro] ## [type ## ["._" unit] ## ["._" refinement] @@ -96,14 +94,7 @@ ## ["._" default ## ["._" evaluation] ## [phase - ## ["._" generation - ## [scheme - ## ["._scheme" function] - ## ["._scheme" loop] - ## ["._scheme" case] - ## ["._scheme" extension] - ## ["._scheme" extension/common] - ## ["._scheme" expression]]] + ## ["._" generation] ## [extension ## ["._" statement]]] ## ["._default" cache]] @@ -339,24 +330,18 @@ ..templates) (<| (_.context "Cross-platform support.") ..cross-platform-support) - (<| (_.context "/abstract") - /abstract.test) - (<| (_.context "/control") - /control.test) - (<| (_.context "/data") - /data.test) + /abstract.test + /control.test + /data.test /macro.test /math.test - (<| (_.context "/time") - /time.test) + /time.test /tool.test /type.test /world.test - (<| (_.context "/host") - ($_ _.and - /host.test - (<| (_.context "/jvm") - /host/jvm.test))) + ($_ _.and + /host.test + /host/jvm.test) ))) (program: args diff --git a/stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux deleted file mode 100644 index 9a635eb9e..000000000 --- a/stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux +++ /dev/null @@ -1,88 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." error ("#;." functor)]] - [compiler - [default - ["." reference] - ["." phase - ["." analysis (#+ Branch Analysis)] - ["//" synthesis (#+ Synthesis) - ["." expression]] - [extension - ["." bundle]]]]] - [math - ["r" random]] - test] - ["." //primitive]) - -(context: "Dummy variables." - (<| (times 100) - (do @ - [maskedA //primitive.primitive - temp (|> r.nat (:: @ map (n/% 100))) - #let [maskA (analysis.control/case - [maskedA - [[(#analysis.Bind temp) - (#analysis.Reference (reference.local temp))] - (list)]])]] - (test "Dummy variables created to mask expressions get eliminated during synthesis." - (|> maskA - expression.phase - (phase.run [bundle.empty //.init]) - (error;map (//primitive.corresponds? maskedA)) - (error.default #0)))))) - -(context: "Let expressions." - (<| (times 100) - (do @ - [registerA r.nat - inputA //primitive.primitive - outputA //primitive.primitive - #let [letA (analysis.control/case - [inputA - [[(#analysis.Bind registerA) - outputA] - (list)]])]] - (test "Can detect and reify simple 'let' expressions." - (|> letA - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.branch/let [inputS registerS outputS]))) - (and (n/= registerA registerS) - (//primitive.corresponds? inputA inputS) - (//primitive.corresponds? outputA outputS)) - - _ - #0)))))) - -(context: "If expressions." - (<| (times 100) - (do @ - [then|else r.bit - inputA //primitive.primitive - thenA //primitive.primitive - elseA //primitive.primitive - #let [thenB (: Branch - [(#analysis.Simple (#analysis.Bit #1)) - thenA]) - elseB (: Branch - [(#analysis.Simple (#analysis.Bit #0)) - elseA]) - ifA (if then|else - (analysis.control/case [inputA [thenB (list elseB)]]) - (analysis.control/case [inputA [elseB (list thenB)]]))]] - (test "Can detect and reify simple 'if' expressions." - (|> ifA - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.branch/if [inputS thenS elseS]))) - (and (//primitive.corresponds? inputA inputS) - (//primitive.corresponds? thenA thenS) - (//primitive.corresponds? elseA elseS)) - - _ - #0)))))) diff --git a/stdlib/source/test/lux/compiler/default/phase/synthesis/function.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/function.lux deleted file mode 100644 index 9d7edb358..000000000 --- a/stdlib/source/test/lux/compiler/default/phase/synthesis/function.lux +++ /dev/null @@ -1,174 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." product] - ["." maybe] - ["." error] - ["." number] - [text - format] - [collection - ["." list ("#;." functor fold)] - ["dict" dictionary (#+ Dictionary)] - ["." set]]] - [compiler - [default - ["." reference (#+ Variable) ("variable;." equivalence)] - ["." phase - ["." analysis (#+ Arity Analysis)] - ["//" synthesis (#+ Synthesis) - ["." expression]] - [extension - ["." bundle]]]]] - [math - ["r" random]] - test] - ["." //primitive]) - -(def: constant-function - (r.Random [Arity Analysis Analysis]) - (r.rec - (function (_ constant-function) - (do r.monad - [function? r.bit] - (if function? - (do @ - [[arity bodyA predictionA] constant-function] - (wrap [(inc arity) - (#analysis.Function (list) bodyA) - predictionA])) - (do @ - [predictionA //primitive.primitive] - (wrap [0 predictionA predictionA]))))))) - -(def: (pick scope-size) - (-> Nat (r.Random Nat)) - (|> r.nat (:: r.monad map (n/% scope-size)))) - -(def: function-with-environment - (r.Random [Arity Analysis Variable]) - (do r.monad - [num-locals (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - #let [indices (list.n/range 0 (dec num-locals)) - local-env (list;map (|>> #reference.Local) indices) - foreign-env (list;map (|>> #reference.Foreign) indices)] - [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable]) - (loop [arity 1 - current-env foreign-env] - (let [current-env/size (list.size current-env) - resolver (list;fold (function (_ [idx var] resolver) - (dict.put idx var resolver)) - (: (Dictionary Nat Variable) - (dict.new number.hash)) - (list.enumerate current-env))] - (do @ - [nest? r.bit] - (if nest? - (do @ - [num-picks (:: @ map (n/max 1) (pick (inc current-env/size))) - picks (|> (r.set number.hash num-picks (pick current-env/size)) - (:: @ map set.to-list)) - [arity bodyA predictionA] (recur (inc arity) - (list;map (function (_ pick) - (maybe.assume (list.nth pick current-env))) - picks)) - #let [picked-env (list;map (|>> #reference.Foreign) picks)]] - (wrap [arity - (#analysis.Function picked-env bodyA) - predictionA])) - (do @ - [chosen (pick (list.size current-env))] - (wrap [arity - (#analysis.Reference (reference.foreign chosen)) - (maybe.assume (dict.get chosen resolver))])))))))] - (wrap [arity - (#analysis.Function local-env bodyA) - predictionA]))) - -(def: local-function - (r.Random [Arity Analysis Variable]) - (loop [arity 0 - nest? #1] - (if nest? - (do r.monad - [nest?' r.bit - [arity' bodyA predictionA] (recur (inc arity) nest?')] - (wrap [arity' - (#analysis.Function (list) bodyA) - predictionA])) - (do r.monad - [chosen (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2))))] - (wrap [arity - (#analysis.Reference (reference.local chosen)) - (|> chosen (n/+ (dec arity)) #reference.Local)]))))) - -(context: "Abstraction." - (<| (times 100) - (do @ - [[arity//constant function//constant prediction//constant] constant-function - [arity//environment function//environment prediction//environment] function-with-environment - [arity//local function//local prediction//local] local-function] - ($_ seq - (test "Nested functions will get folded together." - (|> function//constant - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.function/abstraction [environment arity output]))) - (and (n/= arity//constant arity) - (//primitive.corresponds? prediction//constant output)) - - _ - (n/= 0 arity//constant)))) - (test "Folded functions provide direct access to environment variables." - (|> function//environment - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))]))) - (and (n/= arity//environment arity) - (variable/= prediction//environment output)) - - _ - #0))) - (test "Folded functions properly offset local variables." - (|> function//local - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))]))) - (and (n/= arity//local arity) - (variable/= prediction//local output)) - - _ - #0))) - )))) - -(context: "Application." - (<| (times 100) - (do @ - [arity (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1)))) - funcA //primitive.primitive - argsA (r.list arity //primitive.primitive)] - ($_ seq - (test "Can synthesize function application." - (|> (analysis.apply [funcA argsA]) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.function/apply [funcS argsS]))) - (and (//primitive.corresponds? funcA funcS) - (list.every? (product.uncurry //primitive.corresponds?) - (list.zip2 argsA argsS))) - - _ - #0))) - (test "Function application on no arguments just synthesizes to the function itself." - (|> (analysis.apply [funcA (list)]) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (#error.Success funcS) - (//primitive.corresponds? funcA funcS) - - _ - #0))) - )))) diff --git a/stdlib/source/test/lux/compiler/default/phase/synthesis/primitive.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/primitive.lux deleted file mode 100644 index d6bb57789..000000000 --- a/stdlib/source/test/lux/compiler/default/phase/synthesis/primitive.lux +++ /dev/null @@ -1,97 +0,0 @@ -(.module: - [lux (#- primitive) - [control - [monad (#+ do)] - pipe] - [data - ["." error] - [text - format]] - [compiler - [default - ["." phase - ["." analysis (#+ Analysis)] - ["//" synthesis (#+ Synthesis) - ["." expression]] - [extension - ["." bundle]]]]] - [math - ["r" random]] - test]) - -(def: #export primitive - (r.Random Analysis) - (do r.monad - [primitive (: (r.Random analysis.Primitive) - ($_ r.or - (wrap []) - r.bit - r.nat - r.int - r.rev - r.frac - (r.unicode 5)))] - (wrap (#analysis.Primitive primitive)))) - -(def: #export (corresponds? analysis synthesis) - (-> Analysis Synthesis Bit) - (case [synthesis analysis] - [(#//.Primitive (#//.Text valueS)) - (#analysis.Primitive (#analysis.Unit valueA))] - (is? valueS (:coerce Text valueA)) - - [(#//.Primitive (#//.Bit valueS)) - (#analysis.Primitive (#analysis.Bit valueA))] - (is? valueS valueA) - - [(#//.Primitive (#//.I64 valueS)) - (#analysis.Primitive (#analysis.Nat valueA))] - (is? (.i64 valueS) (.i64 valueA)) - - [(#//.Primitive (#//.I64 valueS)) - (#analysis.Primitive (#analysis.Int valueA))] - (is? (.i64 valueS) (.i64 valueA)) - - [(#//.Primitive (#//.I64 valueS)) - (#analysis.Primitive (#analysis.Rev valueA))] - (is? (.i64 valueS) (.i64 valueA)) - - [(#//.Primitive (#//.F64 valueS)) - (#analysis.Primitive (#analysis.Frac valueA))] - (is? valueS valueA) - - [(#//.Primitive (#//.Text valueS)) - (#analysis.Primitive (#analysis.Text valueA))] - (is? valueS valueA) - - _ - #0)) - -(context: "Primitives." - (<| (times 100) - (do @ - [|bit| r.bit - |nat| r.nat - |int| r.int - |rev| r.rev - |frac| r.frac - |text| (r.unicode 5)] - (`` ($_ seq - (~~ (template [<desc> <analysis> <synthesis> <sample>] - [(test (format "Can synthesize " <desc> ".") - (|> (#analysis.Primitive (<analysis> <sample>)) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (#error.Success (#//.Primitive (<synthesis> value))) - (is? <sample> value) - - _ - #0)))] - - ["unit" #analysis.Unit #//.Text //.unit] - ["bit" #analysis.Bit #//.Bit |bit|] - ["nat" #analysis.Nat #//.I64 (.i64 |nat|)] - ["int" #analysis.Int #//.I64 (.i64 |int|)] - ["rev" #analysis.Rev #//.I64 (.i64 |rev|)] - ["frac" #analysis.Frac #//.F64 |frac|] - ["text" #analysis.Text #//.Text |text|]))))))) diff --git a/stdlib/source/test/lux/compiler/default/phase/synthesis/structure.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/structure.lux deleted file mode 100644 index d24131f04..000000000 --- a/stdlib/source/test/lux/compiler/default/phase/synthesis/structure.lux +++ /dev/null @@ -1,67 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." bit ("#;." equivalence)] - ["." product] - ["." error] - [collection - ["." list]]] - [compiler - [default - ["." phase - ["." analysis] - ["//" synthesis (#+ Synthesis) - ["." expression]] - [extension - ["." bundle]]]]] - [math - ["r" random]] - test] - ["." //primitive]) - -(context: "Variants" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/+ 2)))) - tagA (|> r.nat (:: @ map (n/% size))) - #let [right? (n/= (dec size) tagA) - lefts (if right? - (dec tagA) - tagA)] - memberA //primitive.primitive] - ($_ seq - (test "Can synthesize variants." - (|> (analysis.variant [lefts right? memberA]) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.variant [leftsS right?S valueS]))) - (let [tagS (if right?S (inc leftsS) leftsS)] - (and (n/= tagA tagS) - (|> tagS (n/= (dec size)) (bit;= right?S)) - (//primitive.corresponds? memberA valueS))) - - _ - #0))) - )))) - -(context: "Tuples" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - membersA (r.list size //primitive.primitive)] - ($_ seq - (test "Can synthesize tuple." - (|> (analysis.tuple membersA) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.tuple membersS))) - (and (n/= size (list.size membersS)) - (list.every? (product.uncurry //primitive.corresponds?) - (list.zip2 membersA membersS))) - - _ - #0))) - )))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 91c8d385b..7d1c2676e 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -1,23 +1,18 @@ (.module: [lux #* ["_" test (#+ Test)]] - ## [compiler - ## [phase - ## [synthesis - ## ["_.S" primitive] - ## ["_.S" structure] - ## ["_.S" case] - ## ["_.S" function]]]] ["." / #_ [compiler [default ["#." syntax]] [phase - ["#." analysis]]]]) + ["#." analysis] + ["#." synthesis]]]]) (def: #export test Test ($_ _.and /syntax.test /analysis.test + /synthesis.test )) diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux index 9c9d675fd..7980118a0 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux @@ -61,8 +61,7 @@ (check-failure+ "lux is" (list primC antiC) Bit)) (_.test "Can 'try' risky IO computations." (check-success+ "lux try" - (list (` ("lux coerce" (~ (type.to-code (type (IO primT)))) - ([(~' _) (~' _)] (~ primC))))) + (list (` ("lux io error" "YOLO"))) (type (Either Text primT)))) ))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux new file mode 100644 index 000000000..da9937862 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux @@ -0,0 +1,17 @@ +(.module: + [lux #* + ["_" test (#+ Test)]] + ["." / #_ + ["#." primitive] + ["#." structure] + ["#." case] + ["#." function]]) + +(def: #export test + Test + ($_ _.and + /primitive.test + /structure.test + /case.test + /function.test + )) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux new file mode 100644 index 000000000..ea2114509 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux @@ -0,0 +1,101 @@ +(.module: + [lux #* + [abstract ["." monad (#+ do)]] + [data + text/format + ["." name]] + ["r" math/random (#+ Random) ("#@." monad)] + ["_" test (#+ Test)] + [control + pipe] + [data + ["." error ("#@." functor)]]] + ["." // #_ + ["#." primitive]] + {1 + ["." / + ["/#" // + ["/#" // + [extension + ["#." bundle]] + ["/#" // + ["#." reference] + ["#." analysis (#+ Branch Analysis)] + ["#." synthesis (#+ Synthesis)]]]]]}) + +(def: dummy-vars + Test + (do r.monad + [maskedA //primitive.primitive + temp (|> r.nat (:: @ map (n/% 100))) + #let [maskA (////analysis.control/case + [maskedA + [[(#////analysis.Bind temp) + (#////analysis.Reference (////reference.local temp))] + (list)]])]] + (_.test "Dummy variables created to mask expressions get eliminated during synthesis." + (|> maskA + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (error@map (//primitive.corresponds? maskedA)) + (error.default false))))) + +(def: let-expr + Test + (do r.monad + [registerA r.nat + inputA //primitive.primitive + outputA //primitive.primitive + #let [letA (////analysis.control/case + [inputA + [[(#////analysis.Bind registerA) + outputA] + (list)]])]] + (_.test "Can detect and reify simple 'let' expressions." + (|> letA + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (^ (#error.Success (////synthesis.branch/let [inputS registerS outputS]))) + (and (n/= registerA registerS) + (//primitive.corresponds? inputA inputS) + (//primitive.corresponds? outputA outputS)) + + _ + false))))) + +(def: if-expr + Test + (do r.monad + [then|else r.bit + inputA //primitive.primitive + thenA //primitive.primitive + elseA //primitive.primitive + #let [thenB (: Branch + [(#////analysis.Simple (#////analysis.Bit true)) + thenA]) + elseB (: Branch + [(#////analysis.Simple (#////analysis.Bit false)) + elseA]) + ifA (if then|else + (////analysis.control/case [inputA [thenB (list elseB)]]) + (////analysis.control/case [inputA [elseB (list thenB)]]))]] + (_.test "Can detect and reify simple 'if' expressions." + (|> ifA + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (^ (#error.Success (////synthesis.branch/if [inputS thenS elseS]))) + (and (//primitive.corresponds? inputA inputS) + (//primitive.corresponds? thenA thenS) + (//primitive.corresponds? elseA elseS)) + + _ + false))))) + +(def: #export test + Test + (<| (_.context (name.module (name-of /._))) + ($_ _.and + ..dummy-vars + ..let-expr + ..if-expr + ))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux new file mode 100644 index 000000000..5c6c3f3af --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux @@ -0,0 +1,185 @@ +(.module: + [lux #* + [abstract ["." monad (#+ do)]] + [data + text/format + ["." name]] + ["r" math/random (#+ Random) ("#@." monad)] + ["_" test (#+ Test)] + [control + pipe] + [data + ["." product] + ["." maybe] + ["." error] + [number + ["." nat]] + [collection + ["." list ("#@." functor fold)] + ["dict" dictionary (#+ Dictionary)] + ["." set]]]] + ["." // #_ + ["#." primitive]] + {1 + ["." / + ["/#" // + ["/#" // + [extension + ["#." bundle]] + ["/#" // + ["#." reference (#+ Variable) ("variable@." equivalence)] + ["#." analysis (#+ Arity Analysis)] + ["#." synthesis (#+ Synthesis)]]]]]}) + +(def: constant-function + (Random [Arity Analysis Analysis]) + (r.rec + (function (_ constant-function) + (do r.monad + [function? r.bit] + (if function? + (do @ + [[arity bodyA predictionA] constant-function] + (wrap [(inc arity) + (#////analysis.Function (list) bodyA) + predictionA])) + (do @ + [predictionA //primitive.primitive] + (wrap [0 predictionA predictionA]))))))) + +(def: (pick scope-size) + (-> Nat (Random Nat)) + (|> r.nat (:: r.monad map (n/% scope-size)))) + +(def: function-with-environment + (Random [Arity Analysis Variable]) + (do r.monad + [num-locals (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) + #let [indices (list.n/range 0 (dec num-locals)) + local-env (list@map (|>> #////reference.Local) indices) + foreign-env (list@map (|>> #////reference.Foreign) indices)] + [arity bodyA predictionA] (: (Random [Arity Analysis Variable]) + (loop [arity 1 + current-env foreign-env] + (let [current-env/size (list.size current-env) + resolver (list@fold (function (_ [idx var] resolver) + (dict.put idx var resolver)) + (: (Dictionary Nat Variable) + (dict.new nat.hash)) + (list.enumerate current-env))] + (do @ + [nest? r.bit] + (if nest? + (do @ + [num-picks (:: @ map (n/max 1) (pick (inc current-env/size))) + picks (|> (r.set nat.hash num-picks (pick current-env/size)) + (:: @ map set.to-list)) + [arity bodyA predictionA] (recur (inc arity) + (list@map (function (_ pick) + (maybe.assume (list.nth pick current-env))) + picks)) + #let [picked-env (list@map (|>> #////reference.Foreign) picks)]] + (wrap [arity + (#////analysis.Function picked-env bodyA) + predictionA])) + (do @ + [chosen (pick (list.size current-env))] + (wrap [arity + (#////analysis.Reference (////reference.foreign chosen)) + (maybe.assume (dict.get chosen resolver))])))))))] + (wrap [arity + (#////analysis.Function local-env bodyA) + predictionA]))) + +(def: local-function + (Random [Arity Analysis Variable]) + (loop [arity 0 + nest? #1] + (if nest? + (do r.monad + [nest?' r.bit + [arity' bodyA predictionA] (recur (inc arity) nest?')] + (wrap [arity' + (#////analysis.Function (list) bodyA) + predictionA])) + (do r.monad + [chosen (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2))))] + (wrap [arity + (#////analysis.Reference (////reference.local chosen)) + (|> chosen (n/+ (dec arity)) #////reference.Local)]))))) + +(def: abstraction + Test + (do r.monad + [[arity//constant function//constant prediction//constant] constant-function + [arity//environment function//environment prediction//environment] function-with-environment + [arity//local function//local prediction//local] local-function] + ($_ _.and + (_.test "Nested functions will get folded together." + (|> function//constant + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (^ (#error.Success (////synthesis.function/abstraction [environment arity output]))) + (and (n/= arity//constant arity) + (//primitive.corresponds? prediction//constant output)) + + _ + (n/= 0 arity//constant)))) + (_.test "Folded functions provide direct access to environment variables." + (|> function//environment + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (^ (#error.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))]))) + (and (n/= arity//environment arity) + (variable@= prediction//environment output)) + + _ + #0))) + (_.test "Folded functions properly offset local variables." + (|> function//local + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (^ (#error.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))]))) + (and (n/= arity//local arity) + (variable@= prediction//local output)) + + _ + #0))) + ))) + +(def: application + Test + (do r.monad + [arity (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1)))) + funcA //primitive.primitive + argsA (r.list arity //primitive.primitive)] + ($_ _.and + (_.test "Can synthesize function application." + (|> (////analysis.apply [funcA argsA]) + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (^ (#error.Success (////synthesis.function/apply [funcS argsS]))) + (and (//primitive.corresponds? funcA funcS) + (list.every? (product.uncurry //primitive.corresponds?) + (list.zip2 argsA argsS))) + + _ + #0))) + (_.test "Function application on no arguments just synthesizes to the function itself." + (|> (////analysis.apply [funcA (list)]) + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (#error.Success funcS) + (//primitive.corresponds? funcA funcS) + + _ + #0))) + ))) + +(def: #export test + Test + (<| (_.context (name.module (name-of /._))) + ($_ _.and + ..abstraction + ..application + ))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux new file mode 100644 index 000000000..d5683b14f --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux @@ -0,0 +1,81 @@ +(.module: + [lux (#- primitive) + [abstract ["." monad (#+ do)]] + [data + text/format + ["." name]] + ["r" math/random (#+ Random) ("#@." monad)] + ["_" test (#+ Test)] + [control + pipe] + [data + ["." error]]] + {1 + ["." / #_ + ["/#" // + ["/#" // + [extension + ["#." bundle]] + ["/#" // + ["#." analysis (#+ Analysis)] + ["#." synthesis (#+ Synthesis)]]]]]}) + +(def: #export primitive + (Random Analysis) + (do r.monad + [primitive (: (Random ////analysis.Primitive) + ($_ r.or + (wrap []) + r.bit + r.nat + r.int + r.rev + r.frac + (r.unicode 5)))] + (wrap (#////analysis.Primitive primitive)))) + +(def: #export (corresponds? analysis synthesis) + (-> Analysis Synthesis Bit) + (`` (case [analysis synthesis] + (~~ (template [<analysis> <post-analysis> <synthesis> <post-synthesis>] + [[(#////analysis.Primitive (<analysis> expected)) + (#////synthesis.Primitive (<synthesis> actual))] + (is? (|> expected <post-analysis>) + (|> actual <post-synthesis>))] + + [#////analysis.Unit (:coerce Text) #////synthesis.Text (|>)] + [#////analysis.Bit (|>) #////synthesis.Bit (|>)] + [#////analysis.Nat .i64 #////synthesis.I64 .i64] + [#////analysis.Int .i64 #////synthesis.I64 .i64] + [#////analysis.Rev .i64 #////synthesis.I64 .i64] + [#////analysis.Frac (|>) #////synthesis.F64 (|>)] + [#////analysis.Text (|>) #////synthesis.Text (|>)] + )) + + _ + false))) + +(def: #export test + Test + (<| (_.context (%name (name-of #////synthesis.Primitive))) + (`` ($_ _.and + (~~ (template [<analysis> <synthesis> <generator>] + [(do r.monad + [expected <generator>] + (_.test (%name (name-of <synthesis>)) + (|> (#////analysis.Primitive (<analysis> expected)) + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (#error.Success (#////synthesis.Primitive (<synthesis> actual))) + (is? expected actual) + + _ + false))))] + + [#////analysis.Unit #////synthesis.Text (r@wrap ////synthesis.unit)] + [#////analysis.Bit #////synthesis.Bit r.bit] + [#////analysis.Nat #////synthesis.I64 (r@map .i64 r.nat)] + [#////analysis.Int #////synthesis.I64 (r@map .i64 r.int)] + [#////analysis.Rev #////synthesis.I64 (r@map .i64 r.rev)] + [#////analysis.Frac #////synthesis.F64 r.frac] + [#////analysis.Text #////synthesis.Text (r.unicode 5)])))))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux new file mode 100644 index 000000000..4e7f6c3b5 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux @@ -0,0 +1,75 @@ +(.module: + [lux #* + [abstract ["." monad (#+ do)]] + [data + text/format + ["." name]] + ["r" math/random (#+ Random) ("#@." monad)] + ["_" test (#+ Test)] + [control + pipe] + [data + ["." bit ("#@." equivalence)] + ["." product] + ["." error] + [collection + ["." list]]]] + ["." // #_ + ["#." primitive]] + {1 + ["." / #_ + ["/#" // + ["/#" // + [extension + ["#." bundle]] + ["/#" // + ["#." analysis (#+ Analysis)] + ["#." synthesis (#+ Synthesis)]]]]]}) + +(def: variant + Test + (do r.monad + [size (|> r.nat (:: @ map (|>> (n/% 10) (n/+ 2)))) + tagA (|> r.nat (:: @ map (n/% size))) + #let [right? (n/= (dec size) tagA) + lefts (if right? + (dec tagA) + tagA)] + memberA //primitive.primitive] + (_.test "Can synthesize variants." + (|> (////analysis.variant [lefts right? memberA]) + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (^ (#error.Success (////synthesis.variant [leftsS right?S valueS]))) + (let [tagS (if right?S (inc leftsS) leftsS)] + (and (n/= tagA tagS) + (|> tagS (n/= (dec size)) (bit@= right?S)) + (//primitive.corresponds? memberA valueS))) + + _ + false))))) + +(def: tuple + Test + (do r.monad + [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) + membersA (r.list size //primitive.primitive)] + (_.test "Can synthesize tuple." + (|> (////analysis.tuple membersA) + //.phase + (///.run [///bundle.empty ////synthesis.init]) + (case> (^ (#error.Success (////synthesis.tuple membersS))) + (and (n/= size (list.size membersS)) + (list.every? (product.uncurry //primitive.corresponds?) + (list.zip2 membersA membersS))) + + _ + false))))) + +(def: #export test + Test + (<| (_.context (%name (name-of #////synthesis.Structure))) + ($_ _.and + ..variant + ..tuple + ))) |