diff options
Diffstat (limited to 'stdlib/source/spec/compositor')
7 files changed, 97 insertions, 19 deletions
diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux new file mode 100644 index 000000000..4967c0f8c --- /dev/null +++ b/stdlib/source/spec/compositor/common.lux @@ -0,0 +1,72 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)]] + [data + ["." error (#+ Error)]] + [tool + [compiler + ["." reference] + ["." synthesis (#+ Synthesis)] + ["." statement] + ["." phase + ["." macro (#+ Expander)] + ["." generation (#+ Operation Bundle)] + [extension + ["." bundle]]] + [default + ["." platform (#+ Platform)]]]]]) + +(type: #export Runner (-> Text Synthesis (Error Any))) +(type: #export Definer (-> Name Synthesis (Error Any))) + +(type: #export (Instancer what) + (All [anchor expression statement] + (-> (Platform IO anchor expression statement) + (generation.State+ anchor expression statement) + what))) + +(def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state) + (Instancer Runner) + (function (_ evaluation-name expressionS) + (do error.monad + [expressionG (<| (phase.run state) + generation.with-buffer + (do phase.monad + [_ runtime] + (phase expressionS)))] + (:: host evaluate! evaluation-name expressionG)))) + +(def: (definer (^slots [#platform.runtime #platform.phase #platform.host]) + state) + (Instancer Definer) + (function (_ lux-name expressionS) + (do error.monad + [definitionG (<| (phase.run state) + generation.with-buffer + (do phase.monad + [_ runtime + expressionG (phase expressionS) + [host-name host-value host-statement] (generation.define! lux-name expressionG) + _ (generation.learn lux-name host-name)] + (phase (synthesis.constant lux-name))))] + (:: host evaluate! "definer" definitionG)))) + +(def: #export (executors platform bundle expander program) + (All [anchor expression statement] + (-> (Platform IO anchor expression statement) + (Bundle anchor expression statement) + Expander + (-> expression statement) + (IO (Error [Runner Definer])))) + (do io.monad + [?state (platform.initialize expander platform bundle program)] + (wrap (do error.monad + [[bundle' state] ?state + #let [state (get@ [#statement.generation + #statement.state] + state)]] + (wrap [(..runner platform state) + (..definer platform state)]))))) diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux index 1c398d301..880a26eae 100644 --- a/stdlib/source/spec/compositor/generation/case.lux +++ b/stdlib/source/spec/compositor/generation/case.lux @@ -22,7 +22,8 @@ ["#/." synthesis ["." case]] ["." extension/synthesis]]]]] - ["." ///]) + [/// + [common (#+ Runner)]]) (def: limit Nat 10) @@ -93,7 +94,7 @@ )))) (def: (let-spec run) - (-> ///.Runner Test) + (-> Runner Test) (do r.monad [value r.safe-frac] (_.test (%name (name-of synthesis.branch/let)) @@ -104,7 +105,7 @@ (verify value))))) (def: (if-spec run) - (-> ///.Runner Test) + (-> Runner Test) (do r.monad [on-true r.safe-frac on-false (|> r.safe-frac (r.filter (|>> (f/= on-true) not))) @@ -117,7 +118,7 @@ (verify (if verdict on-true on-false)))))) (def: (case-spec run) - (-> ///.Runner Test) + (-> Runner Test) (do r.monad [[inputS pathS] ..case on-success r.safe-frac @@ -240,7 +241,7 @@ ## TODO: Get rid of this ASAP (def: (special-spec run) - (-> ///.Runner Test) + (-> Runner Test) ($_ _.and (_.test "===" (and (text@= (synthesis.%path special-path) @@ -275,7 +276,7 @@ )) (def: #export (spec run) - (-> ///.Runner Test) + (-> Runner Test) ($_ _.and (..special-spec run) (..let-spec run) diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux index 16ff5aab8..c92859639 100644 --- a/stdlib/source/spec/compositor/generation/common.lux +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -22,7 +22,8 @@ ["." synthesis]]]] ["." // #_ ["#." case] - ["/#" // (#+ Runner)]]) + [// + [common (#+ Runner)]]]) (def: sanitize (-> Text Text) diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux index c9f8f5f56..2a8b4687d 100644 --- a/stdlib/source/spec/compositor/generation/function.lux +++ b/stdlib/source/spec/compositor/generation/function.lux @@ -21,7 +21,8 @@ ["." synthesis (#+ Synthesis)]]]] ["." // #_ ["#." case] - ["/#" //]]) + [// + [common (#+ Runner)]]]) (def: max-arity Arity 10) @@ -45,7 +46,7 @@ #synthesis.body (synthesis.variable/local local)})]))) (def: #export (spec run) - (-> ///.Runner Test) + (-> Runner Test) (do r.monad [[arity local functionS] ..function partial-arity (|> r.nat (:: @ map (|>> (n/% arity) (n/max 1)))) diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux index 788085836..63568fbce 100644 --- a/stdlib/source/spec/compositor/generation/primitive.lux +++ b/stdlib/source/spec/compositor/generation/primitive.lux @@ -17,7 +17,8 @@ [tool [compiler ["." synthesis]]]] - ["." ///]) + [/// + [common (#+ Runner)]]) (def: (f/=' reference subject) (-> Frac Frac Bit) @@ -26,7 +27,7 @@ (frac.not-a-number? subject)))) (def: #export (spec run) - (-> ///.Runner Test) + (-> Runner Test) (`` ($_ _.and (~~ (template [<evaluation-name> <synthesis> <gen> <test>] [(do r.monad diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux index 35de4e8ef..066b604dc 100644 --- a/stdlib/source/spec/compositor/generation/reference.lux +++ b/stdlib/source/spec/compositor/generation/reference.lux @@ -13,7 +13,8 @@ ["." synthesis]]] [math ["r" random (#+ Random)]]] - ["." ///]) + [/// + [common (#+ Runner Definer)]]) (def: name (Random Name) @@ -21,7 +22,7 @@ [(r.and name-part name-part)])) (def: (definition define) - (-> ///.Definer Test) + (-> Definer Test) (do r.monad [name ..name expected r.safe-frac] @@ -34,7 +35,7 @@ false))))) (def: (variable run) - (-> ///.Runner Test) + (-> Runner Test) (do r.monad [register (|> r.nat (:: @ map (n/% 100))) expected r.safe-frac] @@ -50,7 +51,7 @@ false))))) (def: #export (spec runner definer) - (-> ///.Runner ///.Definer Test) + (-> Runner Definer Test) ($_ _.and (..definition definer) (..variable runner))) diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux index 00334596c..99745a819 100644 --- a/stdlib/source/spec/compositor/generation/structure.lux +++ b/stdlib/source/spec/compositor/generation/structure.lux @@ -20,12 +20,13 @@ [compiler ["." analysis] ["." synthesis]]]] - ["." ///]) + [/// + [common (#+ Runner)]]) (import: #long java/lang/Integer) (def: (variant run) - (-> ///.Runner Test) + (-> Runner Test) (do r.monad [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) tag-in (|> r.nat (:: @ map (n/% num-tags))) @@ -60,7 +61,7 @@ false))))) (def: (tuple run) - (-> ///.Runner Test) + (-> Runner Test) (do r.monad [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) tuple-in (r.list size r.i64)] @@ -78,7 +79,7 @@ false))))) (def: #export (spec runner) - (-> ///.Runner Test) + (-> Runner Test) ($_ _.and (..variant runner) (..tuple runner) |