diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/spec/compositor.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/analysis/type.lux | 67 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/common.lux | 17 |
3 files changed, 96 insertions, 19 deletions
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux index 5f46aad84..75818c3cf 100644 --- a/stdlib/source/spec/compositor.lux +++ b/stdlib/source/spec/compositor.lux @@ -11,6 +11,8 @@ ["r" random]] [tool [compiler + ["." analysis] + ["." statement] [phase [macro (#+ Expander)] [generation (#+ Bundle)]] @@ -18,6 +20,8 @@ [platform (#+ Platform)]]]]] ["." / #_ ["#." common (#+ Runner Definer)] + ["#./" analysis #_ + ["#." type]] ["#./" generation #_ ["#." primitive] ["#." structure] @@ -26,9 +30,10 @@ ["#." function] ["#." common]]]) -(def: (test runner definer) - (-> Runner Definer Test) +(def: (test runner definer state expander) + (-> Runner Definer analysis.State+ Expander Test) ($_ _.and + (/analysis/type.spec expander state) (/generation/primitive.spec runner) (/generation/structure.spec runner) (/generation/reference.spec runner definer) @@ -46,16 +51,18 @@ 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) + #let [?state,runner,definer (<| io.run + (do io.monad + [platform platform]) + (/common.executors platform + bundle + expander + program))]] + (case ?state,runner,definer + (#error.Success [[statement-bundle statement-state] runner definer]) + (..test runner definer + (get@ [#statement.analysis #statement.state] statement-state) + expander) (#error.Failure error) (_.fail error)))) diff --git a/stdlib/source/spec/compositor/analysis/type.lux b/stdlib/source/spec/compositor/analysis/type.lux new file mode 100644 index 000000000..a6105bbde --- /dev/null +++ b/stdlib/source/spec/compositor/analysis/type.lux @@ -0,0 +1,67 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." type ("#@." equivalence)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)] + ["." io]] + [data + ["." error] + ["." bit ("#@." equivalence)] + ["." text ("#@." equivalence)]] + [math + ["r" random (#+ Random)]] + [macro + ["." code]] + [tool + [compiler + [analysis (#+ State+)] + ["." phase + [macro (#+ Expander)] + ["." analysis + ["#/." scope] + ["#/." type]]]]]]) + +(def: (check-success+ expander state extension params output-type) + (-> Expander State+ Text (List Code) Type Bit) + (|> (analysis/scope.with-scope "" + (analysis/type.with-type output-type + (analysis.phase expander (` ((~ (code.text extension)) (~+ params)))))) + (phase.run state) + (case> (#error.Success _) + true + + (#error.Failure error) + false))) + +(def: check + (Random [Code Type Code]) + (`` ($_ r.either + (~~ (template [<random> <type> <code>] + [(do r.monad + [value <random>] + (wrap [(` <type>) + <type> + (<code> value)]))] + + [r.bit (0 "#Bit" (0)) code.bit] + [r.nat (0 "#I64" (1 (0 "#Nat" (0)) (0))) code.nat] + [r.int (0 "#I64" (1 (0 "#Int" (0)) (0))) code.int] + [r.rev (0 "#I64" (1 (0 "#Rev" (0)) (0))) code.rev] + [r.safe-frac (0 "#Frac" (0)) code.frac] + [(r.ascii/upper-alpha 5) (0 "#Text" (0)) code.text] + ))))) + +(def: #export (spec expander state) + (-> Expander State+ Test) + (do r.monad + [[typeC exprT exprC] ..check + [other-typeC other-exprT other-exprC] ..check] + ($_ _.and + (_.test "lux check" + (check-success+ expander state "lux check" (list typeC exprC) exprT)) + (_.test "lux coerce" + (check-success+ expander state "lux coerce" (list typeC other-exprC) exprT)) + ))) diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux index 4967c0f8c..df332df57 100644 --- a/stdlib/source/spec/compositor/common.lux +++ b/stdlib/source/spec/compositor/common.lux @@ -60,13 +60,16 @@ (Bundle anchor expression statement) Expander (-> expression statement) - (IO (Error [Runner Definer])))) + (IO (Error [(statement.State+ anchor expression statement) + 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)]))))) + [[statement-bundle statement-state] ?state + #let [generation-state (get@ [#statement.generation + #statement.state] + statement-state)]] + (wrap [[statement-bundle statement-state] + (..runner platform generation-state) + (..definer platform generation-state)]))))) |