diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/spec/compositor.lux | 65 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/reference.lux | 56 |
2 files changed, 101 insertions, 20 deletions
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux index bb90b0cdf..a62d2efa9 100644 --- a/stdlib/source/spec/compositor.lux +++ b/stdlib/source/spec/compositor.lux @@ -8,6 +8,7 @@ ["." error (#+ Error)]] [tool [compiler + ["." reference] ["." synthesis (#+ Synthesis)] ["." statement] ["." phase @@ -21,28 +22,11 @@ (type: #export Runner (-> Text Synthesis (Error Any))) (type: #export Definer (-> Name Synthesis (Error Any))) -(def: #export (runner platform bundle expander program) +(type: #export (Instancer what) (All [anchor expression statement] (-> (Platform IO anchor expression statement) - (Bundle anchor expression statement) - Expander - (-> expression statement) - Runner)) - (function (_ evaluation-name expressionS) - (io.run - (do io.monad - [?state (platform.initialize expander platform bundle program)] - (wrap (do error.monad - [[bundle' state] ?state - expressionG (<| (phase.run (get@ [#statement.generation - #statement.state] - state)) - (do phase.monad - [_ (get@ #platform.runtime platform)] - ((get@ #platform.phase platform) expressionS)))] - (:: (get@ #platform.host platform) evaluate! evaluation-name - expressionG))))) - )) + (generation.State+ anchor expression statement) + what))) ## (def: #export (runner generate-runtime translate bundle state) ## (-> (Operation Any) Phase Bundle (IO State) @@ -55,6 +39,16 @@ ## translation.with-buffer ## (phase.run [bundle (io.run state)])))) +(def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state) + (Instancer Runner) + (function (_ evaluation-name expressionS) + (do error.monad + [expressionG (<| (phase.run state) + (do phase.monad + [_ runtime] + (phase expressionS)))] + (:: host evaluate! evaluation-name expressionG)))) + ## (def: #export (definer generate-runtime translate bundle state) ## (-> (Operation Any) Phase Bundle (IO State) Definer) ## (function (_ lux-name valueS) @@ -67,3 +61,34 @@ ## (translation.evaluate! "definer" program)) ## translation.with-buffer ## (phase.run [bundle (io.run state)])))) + +(def: (definer (^slots [#platform.runtime #platform.phase #platform.host]) + state) + (Instancer Definer) + (function (_ lux-name expressionS) + (do error.monad + [definitionG (<| (phase.run state) + (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/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux new file mode 100644 index 000000000..35de4e8ef --- /dev/null +++ b/stdlib/source/spec/compositor/generation/reference.lux @@ -0,0 +1,56 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)]] + [data + ["." error]] + [tool + [compiler + ["." reference] + ["." synthesis]]] + [math + ["r" random (#+ Random)]]] + ["." ///]) + +(def: name + (Random Name) + (let [name-part (r.ascii/upper-alpha 5)] + [(r.and name-part name-part)])) + +(def: (definition define) + (-> ///.Definer Test) + (do r.monad + [name ..name + expected r.safe-frac] + (_.test "Definitions." + (|> (define name (synthesis.f64 expected)) + (case> (#error.Success actual) + (f/= expected (:coerce Frac actual)) + + (#error.Failure error) + false))))) + +(def: (variable run) + (-> ///.Runner Test) + (do r.monad + [register (|> r.nat (:: @ map (n/% 100))) + expected r.safe-frac] + (_.test "Local variables." + (|> (synthesis.branch/let [(synthesis.f64 expected) + register + (synthesis.variable/local register)]) + (run "variable") + (case> (#error.Success actual) + (f/= expected (:coerce Frac actual)) + + (#error.Failure error) + false))))) + +(def: #export (spec runner definer) + (-> ///.Runner ///.Definer Test) + ($_ _.and + (..definition definer) + (..variable runner))) |