diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/spec/compositor.lux | 69 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/primitive.lux | 47 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/structure.lux | 85 |
3 files changed, 201 insertions, 0 deletions
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux new file mode 100644 index 000000000..bb90b0cdf --- /dev/null +++ b/stdlib/source/spec/compositor.lux @@ -0,0 +1,69 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)]] + [data + ["." error (#+ Error)]] + [tool + [compiler + ["." 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))) + +(def: #export (runner platform bundle expander program) + (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))))) + )) + +## (def: #export (runner generate-runtime translate bundle state) +## (-> (Operation Any) Phase Bundle (IO State) +## Runner) +## (function (_ valueS) +## (|> (do phase.Monad<Operation> +## [_ generate-runtime +## program (translate valueS)] +## (translation.evaluate! "runner" program)) +## translation.with-buffer +## (phase.run [bundle (io.run state)])))) + +## (def: #export (definer generate-runtime translate bundle state) +## (-> (Operation Any) Phase Bundle (IO State) Definer) +## (function (_ lux-name valueS) +## (|> (do phase.Monad<Operation> +## [_ generate-runtime +## valueH (translate valueS) +## [host-name host-value] (translation.define! lux-name valueH) +## _ (translation.learn lux-name host-name) +## program (translate (synthesis.constant lux-name))] +## (translation.evaluate! "definer" program)) +## translation.with-buffer +## (phase.run [bundle (io.run state)])))) diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux new file mode 100644 index 000000000..788085836 --- /dev/null +++ b/stdlib/source/spec/compositor/generation/primitive.lux @@ -0,0 +1,47 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)]] + [data + ["." error] + ["." bit ("#@." equivalence)] + [number + ["." frac]] + ["." text ("#@." equivalence) + format]] + [math + ["r" random]] + [tool + [compiler + ["." synthesis]]]] + ["." ///]) + +(def: (f/=' reference subject) + (-> Frac Frac Bit) + (or (f/= reference subject) + (and (frac.not-a-number? reference) + (frac.not-a-number? subject)))) + +(def: #export (spec run) + (-> ///.Runner Test) + (`` ($_ _.and + (~~ (template [<evaluation-name> <synthesis> <gen> <test>] + [(do r.monad + [expected <gen>] + (_.test (%name (name-of <synthesis>)) + (|> (run <evaluation-name> (<synthesis> expected)) + (case> (#error.Success actual) + (<test> expected (:assume actual)) + + (#error.Failure error) + false))))] + + ["bit" synthesis.bit r.bit bit@=] + ["i64" synthesis.i64 r.i64 "lux i64 ="] + ["f64" synthesis.f64 r.frac f/='] + ["text" synthesis.text (r.ascii 5) text@=] + )) + ))) diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux new file mode 100644 index 000000000..00334596c --- /dev/null +++ b/stdlib/source/spec/compositor/generation/structure.lux @@ -0,0 +1,85 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)]] + [data + ["." error] + ["." maybe] + ["." text ("#@." equivalence) + format] + [collection + ["." array (#+ Array)] + ["." list ("#@." functor)]]] + [math + ["r" random]] + ["." host (#+ import:)] + [tool + [compiler + ["." analysis] + ["." synthesis]]]] + ["." ///]) + +(import: #long java/lang/Integer) + +(def: (variant run) + (-> ///.Runner Test) + (do r.monad + [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) + tag-in (|> r.nat (:: @ map (n/% num-tags))) + #let [last?-in (|> num-tags dec (n/= tag-in))] + value-in r.i64] + (_.test (%name (name-of synthesis.variant)) + (|> (synthesis.variant {#analysis.lefts (if last?-in + (dec tag-in) + tag-in) + #analysis.right? last?-in + #analysis.value (synthesis.i64 value-in)}) + (run "variant") + (case> (#error.Success valueT) + (let [valueT (:coerce (Array Any) valueT)] + (and (n/= 3 (array.size valueT)) + (let [tag-out (:coerce java/lang/Integer (maybe.assume (array.read 0 valueT))) + last?-out (array.read 1 valueT) + value-out (:coerce Any (maybe.assume (array.read 2 valueT))) + same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n/= tag-in)) + same-flag? (case last?-out + (#.Some last?-out') + (and last?-in (text@= "" (:coerce Text last?-out'))) + + #.None + (not last?-in)) + same-value? (|> value-out (:coerce Int) (i/= value-in))] + (and same-tag? + same-flag? + same-value?)))) + + (#error.Failure error) + false))))) + +(def: (tuple run) + (-> ///.Runner Test) + (do r.monad + [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) + tuple-in (r.list size r.i64)] + (_.test (%name (name-of synthesis.tuple)) + (|> (synthesis.tuple (list@map (|>> synthesis.i64) tuple-in)) + (run "tuple") + (case> (#error.Success tuple-out) + (let [tuple-out (:coerce (Array Any) tuple-out)] + (and (n/= size (array.size tuple-out)) + (list.every? (function (_ [left right]) + (i/= left (:coerce Int right))) + (list.zip2 tuple-in (array.to-list tuple-out))))) + + (#error.Failure error) + false))))) + +(def: #export (spec runner) + (-> ///.Runner Test) + ($_ _.and + (..variant runner) + (..tuple runner) + )) |