From 0abd5bd3c0e38e352e9ba38268e04e1c858ab01e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 15 Jul 2021 00:45:15 -0400 Subject: Re-named "spec" hierarchy to "specification". --- stdlib/source/specification/compositor.lux | 67 ++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 stdlib/source/specification/compositor.lux (limited to 'stdlib/source/specification/compositor.lux') diff --git a/stdlib/source/specification/compositor.lux b/stdlib/source/specification/compositor.lux new file mode 100644 index 000000000..08a294282 --- /dev/null +++ b/stdlib/source/specification/compositor.lux @@ -0,0 +1,67 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try]] + [math + ["r" random]] + [tool + [compiler + ["." analysis] + ["." directive] + [phase + [macro (#+ Expander)] + [generation (#+ Bundle)]] + [default + [platform (#+ Platform)]]]]] + ["." / #_ + ["#." common (#+ Runner Definer)] + ["#./" analysis #_ + ["#." type]] + ["#./" generation #_ + ["#." primitive] + ["#." structure] + ["#." reference] + ["#." case] + ["#." function] + ["#." common]]]) + +(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) + (/generation/case.spec runner) + (/generation/function.spec runner) + (/generation/common.spec runner) + )) + +(def: #export (spec platform bundle expander program) + (All [anchor expression directive] + (-> (IO (Platform IO anchor expression directive)) + (Bundle anchor expression directive) + Expander + (-> expression directive) + Test)) + (do r.monad + [_ (wrap []) + #let [?state,runner,definer (<| io.run + (do io.monad + [platform platform]) + (/common.executors platform + bundle + expander + program))]] + (case ?state,runner,definer + (#try.Success [[directive-bundle directive-state] runner definer]) + (..test runner definer + (get@ [#directive.analysis #directive.state] directive-state) + expander) + + (#try.Failure error) + (_.fail error)))) -- cgit v1.2.3