diff options
Diffstat (limited to 'stdlib/source/spec')
| -rw-r--r-- | stdlib/source/spec/compositor.lux | 101 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/common.lux | 72 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/case.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/common.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/function.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/primitive.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/reference.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/structure.lux | 9 |
8 files changed, 142 insertions, 75 deletions
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux index 4967c0f8c..5f46aad84 100644 --- a/stdlib/source/spec/compositor.lux +++ b/stdlib/source/spec/compositor.lux @@ -1,72 +1,61 @@ (.module: [lux #* + ["_" test (#+ Test)] [abstract [monad (#+ do)]] [control ["." io (#+ IO)]] [data - ["." error (#+ Error)]] + ["." error]] + [math + ["r" random]] [tool [compiler - ["." reference] - ["." synthesis (#+ Synthesis)] - ["." statement] - ["." phase - ["." macro (#+ Expander)] - ["." generation (#+ Operation Bundle)] - [extension - ["." bundle]]] + [phase + [macro (#+ Expander)] + [generation (#+ Bundle)]] [default - ["." platform (#+ Platform)]]]]]) + [platform (#+ Platform)]]]]] + ["." / #_ + ["#." common (#+ Runner Definer)] + ["#./" generation #_ + ["#." primitive] + ["#." structure] + ["#." reference] + ["#." case] + ["#." function] + ["#." common]]]) -(type: #export Runner (-> Text Synthesis (Error Any))) -(type: #export Definer (-> Name Synthesis (Error Any))) +(def: (test runner definer) + (-> Runner Definer Test) + ($_ _.and + (/generation/primitive.spec runner) + (/generation/structure.spec runner) + (/generation/reference.spec runner definer) + (/generation/case.spec runner) + (/generation/function.spec runner) + (/generation/common.spec runner) + )) -(type: #export (Instancer what) +(def: #export (spec platform bundle expander program) (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) + (-> (IO (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)]))))) + Test)) + (do r.monad + [_ (wrap []) + #let [?runner,definer (<| io.run + (do io.monad + [platform platform]) + (/common.executors platform + bundle + expander + program))]] + (case ?runner,definer + (#error.Success [runner definer]) + (..test runner definer) + + (#error.Failure error) + (_.fail error)))) 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) |