From 084e3c400410e954b633a07c98f32ecfa62f1ec8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 26 Apr 2019 21:37:40 -0400 Subject: Ported reference tests. --- new-luxc/source/test/program.lux | 30 +++++--- .../test/test/luxc/lang/translation/reference.lux | 86 ---------------------- new-luxc/test/tests.lux | 28 ------- stdlib/source/spec/compositor.lux | 65 +++++++++++----- .../spec/compositor/generation/reference.lux | 56 ++++++++++++++ 5 files changed, 121 insertions(+), 144 deletions(-) delete mode 100644 new-luxc/test/test/luxc/lang/translation/reference.lux delete mode 100644 new-luxc/test/tests.lux create mode 100644 stdlib/source/spec/compositor/generation/reference.lux diff --git a/new-luxc/source/test/program.lux b/new-luxc/source/test/program.lux index 40eb214c2..687c8ca2a 100644 --- a/new-luxc/source/test/program.lux +++ b/new-luxc/source/test/program.lux @@ -7,13 +7,16 @@ ["." io] [parser [cli (#+ program:)]]] + [data + ["." error]] [math ["r" random]]] [spec - ["." compositor (#+ Runner) + ["." compositor (#+ Runner Definer) [generation ["." primitive] - ["." structure]]]] + ["." structure] + ["." reference]]]] {1 ["." /]} ## [test @@ -21,7 +24,6 @@ ## [lang ## [translation ## ## ["_.T" function] - ## ## ["_.T" reference] ## ## ["_.T" case] ## ## ["_.T" common] ## ## ["_.T" jvm] @@ -36,11 +38,12 @@ ## ]]]] ) -(def: (test runner) - (-> Runner Test) +(def: (test runner definer) + (-> Runner Definer Test) ($_ _.and (primitive.spec runner) (structure.spec runner) + (reference.spec runner definer) )) (program: args @@ -49,8 +52,15 @@ (_.times 100) (do r.monad [_ (wrap []) - #let [platform (io.run /.jvm)]]) - (..test (compositor.runner platform - /.bundle - /.expander - /.program)))) + #let [?runner,definer (io.run (do io.monad + [platform /.jvm] + (compositor.executors platform + /.bundle + /.expander + /.program)))]] + (case ?runner,definer + (#error.Success [runner definer]) + (..test runner definer) + + (#error.Failure error) + (_.fail error))))) diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux deleted file mode 100644 index 18205a560..000000000 --- a/new-luxc/test/test/luxc/lang/translation/reference.lux +++ /dev/null @@ -1,86 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." number]] - [compiler - [default - ["." reference] - [phase - ["." synthesis]]]] - [math - ["r" random (#+ Random)]] - test] - [test - [luxc - ["." common (#+ Runner Definer)]]] - [// - ["&" function]]) - -(def: name - (Random Name) - (let [name-part (r.ascii/upper-alpha 5)] - [(r.and name-part name-part)])) - -(def: (definitions-spec define) - (-> Definer Test) - (do r.Monad - [name ..name - value &.safe-frac] - (test "Can refer to definitions." - (|> (define name (synthesis.f64 value)) - (&.check value))))) - -(def: (variables-spec run) - (-> Runner Test) - (do r.Monad - [register (|> r.nat (:: @ map (n/% 100))) - value &.safe-frac] - (test "Can refer to local variables/registers." - (|> (run (synthesis.branch/let [(synthesis.f64 value) - register - (synthesis.variable/local register)])) - (&.check value))))) - -(def: (references-spec run define) - (-> Runner Definer Test) - (seq (definitions-spec define) - (variables-spec run))) - -(context: "[JVM] References." - (<| (times 100) - (references-spec common.run-jvm common.def-jvm))) - -## (context: "[JS] References." -## (<| (times 100) -## (references-spec common.run-js common.def-js))) - -## (context: "[Lua] References." -## (<| (times 100) -## (references-spec common.run-lua common.def-lua))) - -## (context: "[Ruby] References." -## (<| (times 100) -## (references-spec common.run-ruby common.def-ruby))) - -## (context: "[Python] References." -## (<| (times 100) -## (references-spec common.run-python common.def-python))) - -## (context: "[R] References." -## (<| (times 100) -## (references-spec common.run-r common.def-r))) - -## (context: "[Scheme] References." -## (<| (times 100) -## (references-spec common.run-scheme common.def-scheme))) - -## (context: "[Common Lisp] References." -## (<| (times 100) -## (references-spec common.run-common-lisp common.def-common-lisp))) - -## (context: "[PHP] References." -## (<| (times 100) -## (references-spec common.run-php common.def-php))) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux deleted file mode 100644 index 04362d4d1..000000000 --- a/new-luxc/test/tests.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - [lux - [cli (#+ program:)] - ["." test]] - [test - [luxc - [lang - [translation - ["_.T" primitive] - ["_.T" structure] - ["_.T" function] - ["_.T" reference] - ["_.T" case] - ["_.T" common] - ## ["_.T" jvm] - ## ["_.T" js] - ## ["_.T" lua] - ## ["_.T" ruby] - ## ["_.T" python] - ## ["_.T" r] - ## ["_.T" scheme] - ## ["_.T" common-lisp] - ## ["_.T" php] - ]]]] - ) - -(program: args - (test.run)) 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))) -- cgit v1.2.3