diff options
Diffstat (limited to '')
21 files changed, 423 insertions, 194 deletions
diff --git a/stdlib/source/lux/control/function/mixin.lux b/stdlib/source/lux/control/function/mixin.lux index 4a79bb99a..328115ec4 100644 --- a/stdlib/source/lux/control/function/mixin.lux +++ b/stdlib/source/lux/control/function/mixin.lux @@ -18,13 +18,13 @@ (def: #export nothing Mixin - (function (_ super self) - super)) + (function (_ delegate recur) + delegate)) (def: #export (inherit parent child) (All [m] (-> (Mixin m) (Mixin m) (Mixin m))) - (function (_ super self) - (parent (child super self) self))) + (function (_ delegate recur) + (parent (child delegate recur) recur))) (structure: #export monoid (All [m] (Monoid (Mixin m))) @@ -32,14 +32,6 @@ (def: identity ..nothing) (def: compose ..inherit)) -(type: #export (Recursive i o) - (-> (-> i o) (-> i o))) - -(def: #export (from-recursive recursive) - (All [i o] (-> (Recursive i o) (Mixin (-> i o)))) - (function (_ delegate recur) - (recursive recur))) - (def: #export (advice when then) (All [i o] (-> (Predicate i) (Mixin (-> i o)) (Mixin (-> i o)))) (function (_ delegate recur input) @@ -61,3 +53,11 @@ [output (delegate input) _ (action input output)] (wrap output)))) + +(type: #export (Recursive i o) + (-> (-> i o) (-> i o))) + +(def: #export (from-recursive recursive) + (All [i o] (-> (Recursive i o) (Mixin (-> i o)))) + (function (_ delegate recur) + (recursive recur))) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 73453902a..0356d6b85 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -168,7 +168,9 @@ type )) -(structure: #export equivalence (Equivalence Type) +(structure: #export equivalence + (Equivalence Type) + (def: (= x y) (or (is? x y) (case [x y] diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index a49c49f2a..1e81d37c1 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -112,7 +112,8 @@ [ordered-async Promise promise.monad Ordered ordered-key] [commutative-sync IO io.monad Commutative commutative-key] [commutative-pure Identity identity.monad Commutative commutative-key] - [commutative-async Promise promise.monad Commutative commutative-key]) + [commutative-async Promise promise.monad Commutative commutative-key] + ) (template [<name> <m> <monad>] [(def: #export (<name> resource) @@ -123,7 +124,8 @@ [read-pure Identity identity.monad] [read-sync IO io.monad] - [read-async Promise promise.monad])) + [read-async Promise promise.monad] + )) (exception: #export (index-cannot-be-repeated {index Nat}) (exception.report @@ -181,7 +183,8 @@ [exchange-pure Identity identity.monad] [exchange-sync IO io.monad] - [exchange-async Promise promise.monad]) + [exchange-async Promise promise.monad] + ) (def: amount (Parser Nat) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 5c7f7b9ef..56be46610 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -3,34 +3,34 @@ ["_" test (#+ Test)]] ["." / #_ ["#." concatenative] + [concurrency + ["#." actor] + ["#." atom] + ["#." frp] + ["#." process] + ["#." promise] + ["#." semaphore] + ["#." stm]] ["#." continuation] ["#." exception] ["#." function + ["#/." contract] ["#/." memo] - ["#/." contract]] + ["#/." mixin]] ["#." try] ["#." io] - ["#." parser] + ["#." parser + ["#/." text] + ["#/." cli]] ["#." pipe] ["#." reader] ["#." region] ["#." remember] + [security + ["#." policy]] ["#." state] ["#." thread] - ["#." writer] - [concurrency - ["#." actor] - ["#." atom] - ["#." frp] - ["#." process] - ["#." promise] - ["#." semaphore] - ["#." stm]] - ["#." parser #_ - ["#/." text] - ["#/." cli]] - [security - ["#." policy]]]) + ["#." writer]]) (def: concurrency Test @@ -48,8 +48,9 @@ Test ($_ _.and /function.test - /function/memo.test /function/contract.test + /function/memo.test + /function/mixin.test )) (def: parser @@ -70,19 +71,19 @@ Test ($_ _.and /concatenative.test + ..concurrency /continuation.test /exception.test ..function - /try.test /io.test ..parser /pipe.test /reader.test /region.test /remember.test + ..security /state.test /thread.test + /try.test /writer.test - ..concurrency - ..security )) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index fe9362b07..f63de1509 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -84,14 +84,15 @@ (promise.promise []))] (:: random.monad wrap (do promise.monad - [result (promise.future (do io.monad - [actor (/.spawn {#/.handle (function (_ message state self) - (message state self)) - #/.end (function (_ cause state) - (promise.future (write cause)))} - write) - _ (/.poison actor)] - (promise.poll read)))] + [_ (promise.future (do io.monad + [actor (/.spawn {#/.handle (function (_ message state self) + (message state self)) + #/.end (function (_ cause state) + (promise.future (write cause)))} + write)] + (/.poison actor))) + _ (promise.wait 100) + result (promise.future (promise.poll read))] (_.claim [/.poisoned] (case result (#.Some error) diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 5b5c91271..a00b8bc58 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -1,16 +1,20 @@ (.module: [lux #* ["_" test (#+ Test)] - [abstract/monad (#+ do)] - ["%" data/text/format (#+ format)] + [abstract + [monad (#+ do)]] [control ["." io (#+ IO)] - ["." state ("#@." monad)]] + ["." state (#+ State) ("#@." monad)]] [math - ["r" random]] + ["." random]] [data + ["." product] [number - ["n" nat]]] + ["n" nat]] + [collection + ["." dictionary (#+ Dictionary)] + ["." list ("#@." functor fold)]]] [time ["." instant] ["." duration (#+ Duration)]]] @@ -19,14 +23,14 @@ ["/#" // #_ ["#" mixin]]]}) -(def: (fibonacci fibonacci input) +(def: (fibonacci recur input) (/.Memo Nat Nat) (case input 0 (state@wrap 0) 1 (state@wrap 1) _ (do state.monad - [output-1 (fibonacci (n.- 1 input)) - output-2 (fibonacci (n.- 2 input))] + [output-1 (recur (n.- 1 input)) + output-2 (recur (n.- 2 input))] (wrap (n.+ output-1 output-2))))) (def: (time function input) @@ -38,20 +42,58 @@ (wrap [(instant.span before after) output]))) +(def: milli-seconds + (-> Duration Nat) + (|>> (duration.query duration.milli-second) .nat)) + (def: #export test Test - (<| (_.context (%.name (name-of /.memoization))) - (let [fast (/.closed n.hash fibonacci) - slow (/.none n.hash ..fibonacci)] - (do r.monad - [input (wrap 30) - #let [prefix (format (%.name (name-of /.memoization)) " => " (%.nat input) " => ")]] - (_.test "Memoization makes certain computations faster." - (io.run - (do io.monad - [[fast-time fast-output] (..time fast input) - [slow-time slow-output] (..time slow input) - #let [_ (log! (format prefix " memoized = " (%.duration fast-time))) - _ (log! (format prefix "non-memoized = " (%.duration slow-time)))]] - (wrap (and (n.= fast-output slow-output) - (:: duration.order < slow-time fast-time)))))))))) + (<| (_.covering /._) + (do {@ random.monad} + [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20))))]) + (_.with-cover [/.Memo]) + ($_ _.and + (_.cover [/.closed /.none] + (io.run + (do io.monad + [#let [slow (/.none n.hash ..fibonacci) + fast (/.closed n.hash fibonacci)] + [slow-time slow-output] (..time slow input) + [fast-time fast-output] (..time fast input)] + (wrap (and (n.= slow-output + fast-output) + (n.< (milli-seconds slow-time) + (milli-seconds fast-time))))))) + (_.cover [/.open] + (io.run + (do io.monad + [#let [none (/.none n.hash ..fibonacci) + memory (dictionary.new n.hash) + open (/.open fibonacci)] + [none-time none-output] (..time none input) + [open-time [memory open-output]] (..time open [memory input]) + [open-time/+1 _] (..time open [memory (inc input)])] + (wrap (and (n.= none-output + open-output) + (n.< (milli-seconds none-time) + (milli-seconds open-time)) + (n.< (milli-seconds open-time) + (milli-seconds open-time/+1))))))) + (_.cover [/.memoization] + (let [memo (<| //.mixin + (//.inherit /.memoization) + (: (//.Mixin (-> Nat (State (Dictionary Nat Nat) Nat))) + (function (factorial delegate recur input) + (case input + (^or 0 1) (:: state.monad wrap 1) + _ (do state.monad + [output' (recur (dec input))] + (wrap (n.* input output'))))))) + expected (|> (list.indices input) + (list@map inc) + (list@fold n.* 1)) + actual (|> (memo input) + (state.run (dictionary.new n.hash)) + product.right)] + (n.= expected actual))) + ))) diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux new file mode 100644 index 000000000..b9f2e766f --- /dev/null +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -0,0 +1,135 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [equivalence (#+ Equivalence)] + [predicate (#+ Predicate)] + [monad (#+ do)] + {[0 #test] + [/ + ["$." monoid]]}] + [control + ["." state (#+ State)]] + [data + ["." product] + [number + ["n" nat]] + [collection + ["." list ("#@." functor fold)]]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {@ random.monad} + [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20)))) + dummy random.nat + shift (|> random.nat (random.filter (|>> (n.= dummy) not))) + #let [equivalence (: (Equivalence (/.Mixin (-> Nat Nat))) + (structure + (def: (= left right) + (n.= ((/.mixin left) input) + ((/.mixin right) input))))) + generator (: (Random (/.Mixin (-> Nat Nat))) + (do @ + [output random.nat] + (wrap (function (_ delegate recur input) + output)))) + expected (|> (list.indices input) + (list@map inc) + (list@fold n.* 1))]]) + ($_ _.and + (_.with-cover [/.Mixin] + ($_ _.and + (_.with-cover [/.monoid] + ($monoid.spec equivalence /.monoid generator)) + + (_.cover [/.mixin] + (let [factorial (/.mixin + (function (_ delegate recur input) + (case input + (^or 0 1) 1 + _ (n.* input (recur (dec input))))))] + (n.= expected + (factorial input)))) + (_.cover [/.inherit] + (let [bottom (: (/.Mixin (-> Nat Nat)) + (function (_ delegate recur input) + (case input + (^or 0 1) 1 + _ (delegate input)))) + multiplication (: (/.Mixin (-> Nat Nat)) + (function (_ delegate recur input) + (n.* input (recur (dec input))))) + factorial (/.mixin (/.inherit bottom multiplication))] + (n.= expected + (factorial input)))) + (_.cover [/.nothing] + (let [loop (: (/.Mixin (-> Nat Nat)) + (function (_ delegate recur input) + (case input + (^or 0 1) 1 + _ (n.* input (delegate (dec input)))))) + left (/.mixin (/.inherit /.nothing loop)) + right (/.mixin (/.inherit loop /.nothing))] + (and (n.= expected + (left input)) + (n.= expected + (right input))))) + (_.cover [/.advice] + (let [bottom (: (/.Mixin (-> Nat Nat)) + (function (_ delegate recur input) + 1)) + bottom? (: (Predicate Nat) + (function (_ input) + (case input + (^or 0 1) true + _ false))) + multiplication (: (/.Mixin (-> Nat Nat)) + (function (_ delegate recur input) + (n.* input (recur (dec input))))) + factorial (/.mixin (/.inherit (/.advice bottom? bottom) + multiplication))] + (n.= expected + (factorial input)))) + (_.cover [/.before] + (let [implant (: (-> Nat (State Nat [])) + (function (_ input) + (function (_ state) + [shift []]))) + meld (: (/.Mixin (-> Nat (State Nat Nat))) + (function (_ delegate recur input) + (function (_ state) + [state (n.+ state input)]))) + function (/.mixin (/.inherit (/.before state.monad implant) + meld))] + (n.= (n.+ shift input) + (|> input function (state.run dummy) product.right)))) + (_.cover [/.after] + (let [implant (: (-> Nat Nat (State Nat [])) + (function (_ input output) + (function (_ state) + [shift []]))) + meld (: (/.Mixin (-> Nat (State Nat Nat))) + (function (_ delegate recur input) + (function (_ state) + [state (n.+ state input)]))) + function (/.mixin (/.inherit (/.after state.monad implant) + meld))] + (n.= (n.+ dummy input) + (|> input function (state.run dummy) product.right)))) + )) + (_.with-cover [/.Recursive] + (_.cover [/.from-recursive] + (let [factorial (/.mixin + (/.from-recursive + (function (_ recur input) + (case input + (^or 0 1) 1 + _ (n.* input (recur (dec input)))))))] + (n.= expected + (factorial input))))) + ))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 7d1c2676e..5452fbb65 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -3,11 +3,12 @@ ["_" test (#+ Test)]] ["." / #_ [compiler - [default - ["#." syntax]] - [phase - ["#." analysis] - ["#." synthesis]]]]) + [language + [lux + ["#." syntax] + [phase + ["#." analysis] + ["#." synthesis]]]]]]) (def: #export test Test diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux index 06b09fbf9..06b09fbf9 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux index 1ca4718c1..71c523649 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -29,9 +29,13 @@ ["/#" // ["#." module] ["#." type] - ["/#" // + ["/#" // #_ ["/#" // - ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]}) + ["#." analysis (#+ Analysis Variant Tag Operation)] + [/// + ["." phase] + [meta + ["." archive]]]]]]]}) (def: (exhaustive-weaving branchings) (-> (List (List Code)) (List (List Code))) @@ -152,17 +156,18 @@ inputC (input variant-tags+ record-tags+ primitivesC) [outputT outputC] (r.filter (|>> product.left (is? Any) not) _primitive.primitive) - #let [analyse-pm (|>> (/.case _primitive.phase inputC) - (//type.with-type outputT) - ////analysis.with-scope - (do ///.monad - [_ (//module.declare-tags variant-tags false - (#.Named [module-name variant-name] - (type.variant primitivesT))) - _ (//module.declare-tags record-tags false - (#.Named [module-name record-name] - (type.tuple primitivesT)))]) - (//module.with-module 0 module-name))] + #let [analyse-pm (function (_ branches) + (|> (/.case _primitive.phase branches archive.empty inputC) + (//type.with-type outputT) + ////analysis.with-scope + (do phase.monad + [_ (//module.declare-tags variant-tags false + (#.Named [module-name variant-name] + (type.variant primitivesT))) + _ (//module.declare-tags record-tags false + (#.Named [module-name record-name] + (type.tuple primitivesT)))]) + (//module.with-module 0 module-name)))] exhaustive-patterns (exhaustive-branches true variantTC inputC) #let [exhaustive-branchesC (list@map (branch outputC) exhaustive-patterns)]] diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index fc07f8963..3dbacc0e2 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -1,6 +1,7 @@ (.module: [lux #* - [abstract ["." monad (#+ do)]] + [abstract + ["." monad (#+ do)]] [data ["%" text/format (#+ format)] ["." name ("#@." equivalence)]] @@ -28,16 +29,20 @@ ["/#" // ["#." module] ["#." type] - ["/#" // + ["/#" // #_ ["/#" // - ["#." reference] - ["#." analysis (#+ Analysis Operation)]]]]]}) + ["#." analysis (#+ Analysis Operation)] + [/// + ["#." reference] + ["." phase] + [meta + ["." archive]]]]]]]}) (def: (check-apply expectedT num-args analysis) (-> Type Nat (Operation Analysis) Bit) (|> analysis (//type.with-type expectedT) - (///.run _primitive.state) + (phase.run _primitive.state) (case> (#try.Success applyA) (let [[funcA argsA] (////analysis.application applyA)] (n.= num-args (list.size argsA))) @@ -56,21 +61,21 @@ ($_ _.and (_.test "Can analyse function." (and (|> (//type.with-type (All [a] (-> a outputT)) - (/.function _primitive.phase func-name arg-name outputC)) + (/.function _primitive.phase func-name arg-name archive.empty outputC)) _structure.check-succeeds) (|> (//type.with-type (All [a] (-> a a)) - (/.function _primitive.phase func-name arg-name g!arg)) + (/.function _primitive.phase func-name arg-name archive.empty g!arg)) _structure.check-succeeds))) (_.test "Generic functions can always be specialized." (and (|> (//type.with-type (-> inputT outputT) - (/.function _primitive.phase func-name arg-name outputC)) + (/.function _primitive.phase func-name arg-name archive.empty outputC)) _structure.check-succeeds) (|> (//type.with-type (-> inputT inputT) - (/.function _primitive.phase func-name arg-name g!arg)) + (/.function _primitive.phase func-name arg-name archive.empty g!arg)) _structure.check-succeeds))) (_.test "The function's name is bound to the function's type." (|> (//type.with-type (Rec self (-> inputT self)) - (/.function _primitive.phase func-name arg-name (code.local-identifier func-name))) + (/.function _primitive.phase func-name arg-name archive.empty (code.local-identifier func-name))) _structure.check-succeeds)) )))) @@ -102,19 +107,19 @@ (<| (_.context (%.name (name-of /.apply))) ($_ _.and (_.test "Can analyse monomorphic type application." - (|> (/.apply _primitive.phase funcT dummy-function (' []) inputsC) + (|> (/.apply _primitive.phase inputsC funcT dummy-function archive.empty (' [])) (check-apply outputT full-args))) (_.test "Can partially apply functions." - (|> (/.apply _primitive.phase funcT dummy-function (' []) (list.take partial-args inputsC)) + (|> (/.apply _primitive.phase (list.take partial-args inputsC) funcT dummy-function archive.empty (' [])) (check-apply partialT partial-args))) (_.test "Can apply polymorphic functions." - (|> (/.apply _primitive.phase polyT dummy-function (' []) inputsC) + (|> (/.apply _primitive.phase inputsC polyT dummy-function archive.empty (' [])) (check-apply poly-inputT full-args))) (_.test "Polymorphic partial application propagates found type-vars." - (|> (/.apply _primitive.phase polyT dummy-function (' []) (list.take (inc var-idx) inputsC)) + (|> (/.apply _primitive.phase (list.take (inc var-idx) inputsC) polyT dummy-function archive.empty (' [])) (check-apply partial-polyT1 (inc var-idx)))) (_.test "Polymorphic partial application preserves quantification for type-vars." - (|> (/.apply _primitive.phase polyT dummy-function (' []) (list.take var-idx inputsC)) + (|> (/.apply _primitive.phase (list.take var-idx inputsC) polyT dummy-function archive.empty (' [])) (check-apply partial-polyT2 var-idx))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux index 57c3152d9..d2864e6a1 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux @@ -1,7 +1,8 @@ (.module: [lux (#- primitive) ["@" target] - [abstract ["." monad (#+ do)]] + [abstract + ["." monad (#+ do)]] [data ["%" text/format (#+ format)] ["." name]] @@ -18,22 +19,25 @@ ["." / ["/#" // ["#." type] - ["/#" // - [macro (#+ Expander)] + ["/#" // #_ [extension ["." bundle] ["#." analysis]] - ["/#" // - ["#." analysis (#+ Analysis Operation)] - [default - [evaluation (#+ Eval)] - ["." init]]]]]]}) + ["/#" // #_ + ["." version] + ["#." analysis (#+ Analysis Operation) + [macro (#+ Expander)] + [evaluation (#+ Eval)]] + [/// + ["." phase] + [meta + ["." archive]]]]]]]}) (def: #export (expander macro inputs state) Expander (#try.Failure "NOPE")) -(def: #export (eval count type expression) +(def: #export (eval archive count type expression) Eval (function (_ state) (#try.Failure "NO!"))) @@ -45,7 +49,7 @@ (def: #export state ////analysis.State+ [(///analysis.bundle ..eval bundle.empty) - (////analysis.state (init.info @.jvm) [])]) + (////analysis.state (////analysis.info version.version @.jvm))]) (def: #export primitive (Random [Type Code]) @@ -71,7 +75,7 @@ (-> Type (Operation Analysis) (Try Analysis)) (|> analysis //type.with-inference - (///.run ..state) + (phase.run ..state) (case> (#try.Success [inferred-type output]) (if (is? expected-type inferred-type) (#try.Success output) @@ -84,7 +88,7 @@ (<| (_.context (name.module (name-of /._))) (`` ($_ _.and (_.test (%.name (name-of #////analysis.Unit)) - (|> (infer Any (..phase (' []))) + (|> (infer Any (..phase archive.empty (' []))) (case> (^ (#try.Success (#////analysis.Primitive (#////analysis.Unit output)))) (is? [] output) @@ -94,7 +98,7 @@ [(do r.monad [sample <random>] (_.test (%.name (name-of <tag>)) - (|> (infer <type> (..phase (<constructor> sample))) + (|> (infer <type> (..phase archive.empty (<constructor> sample))) (case> (#try.Success (#////analysis.Primitive (<tag> output))) (is? sample output) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 9cb0c1170..7197dbca6 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -23,10 +23,14 @@ ["#." scope] ["#." module] ["#." type] - ["/#" // + ["/#" // #_ ["/#" // - ["#." reference] - ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]}) + ["#." analysis (#+ Analysis Variant Tag Operation)] + [/// + ["#." reference] + ["." phase] + [meta + ["." archive]]]]]]]}) (type: Check (-> (Try Any) Bit)) @@ -45,7 +49,7 @@ (def: (reach-test var-name [export? def-module] [import? dependent-module] check!) (-> Text [Bit Text] [Bit Text] Check Bit) - (|> (do {@ ///.monad} + (|> (do {@ phase.monad} [_ (//module.with-module 0 def-module (//module.define var-name (#.Right [export? Any (' {}) []])))] (//module.with-module 0 dependent-module @@ -54,8 +58,8 @@ (//module.import def-module) (wrap []))] (//type.with-inference - (_primitive.phase (code.identifier [def-module var-name])))))) - (///.run _primitive.state) + (_primitive.phase archive.empty (code.identifier [def-module var-name])))))) + (phase.run _primitive.state) check!)) (def: #export test @@ -72,8 +76,8 @@ (|> (//scope.with-scope scope-name (//scope.with-local [var-name expectedT] (//type.with-inference - (_primitive.phase (code.local-identifier var-name))))) - (///.run _primitive.state) + (_primitive.phase archive.empty (code.local-identifier var-name))))) + (phase.run _primitive.state) (case> (^ (#try.Success [inferredT (#////analysis.Reference (////reference.local var))])) (and (type@= expectedT inferredT) (n.= 0 var)) @@ -82,12 +86,12 @@ false))) (_.test "Can analyse definition (in the same module)." (let [def-name [def-module var-name]] - (|> (do ///.monad + (|> (do phase.monad [_ (//module.define var-name (#.Right [false expectedT (' {}) []]))] (//type.with-inference - (_primitive.phase (code.identifier def-name)))) + (_primitive.phase archive.empty (code.identifier def-name)))) (//module.with-module 0 def-module) - (///.run _primitive.state) + (phase.run _primitive.state) (case> (^ (#try.Success [_ inferredT (#////analysis.Reference (////reference.constant constant-name))])) (and (type@= expectedT inferredT) (name@= def-name constant-name)) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 05461adf6..fb3c1fe60 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -30,14 +30,18 @@ ["/#" // ["#." module] ["#." type] - ["/#" // + ["/#" // #_ ["/#" // - ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]}) + ["#." analysis (#+ Analysis Variant Tag Operation)] + [/// + ["." phase] + [meta + ["." archive]]]]]]]}) (template [<name> <on-success> <on-error>] [(def: #export <name> (All [a] (-> (Operation a) Bit)) - (|>> (///.run _primitive.state) + (|>> (phase.run _primitive.state) (case> (#try.Success _) <on-success> @@ -65,7 +69,7 @@ (-> Type Tag Nat (Operation Analysis) Bit) (|> analysis (//type.with-type type) - (///.run _primitive.state) + (phase.run _primitive.state) (case> (^ (#try.Success (////analysis.variant variant))) (check-sum' tag size variant) @@ -74,7 +78,7 @@ (def: (with-tags module tags type) (All [a] (-> Text (List //module.Tag) Type (Operation a) (Operation [Module a]))) - (|>> (do ///.monad + (|>> (do phase.monad [_ (//module.declare-tags tags false type)]) (//module.with-module 0 module))) @@ -83,7 +87,7 @@ (|> analysis (with-tags module tags variantT) (//type.with-type expectedT) - (///.run _primitive.state) + (phase.run _primitive.state) (case> (^ (#try.Success [_ (////analysis.variant variant)])) (check-sum' tag (list.size tags) variant) @@ -105,7 +109,7 @@ (|> analysis (with-tags module tags recordT) (//type.with-type expectedT) - (///.run _primitive.state) + (phase.run _primitive.state) (case> (#try.Success [_ productA]) (correct-size? size productA) @@ -131,36 +135,36 @@ ($_ _.and (_.test "Can analyse." (check-sum variantT choice size - (/.sum _primitive.phase choice valueC))) + (/.sum _primitive.phase choice archive.empty valueC))) (_.test "Can analyse through bound type-vars." - (|> (do ///.monad + (|> (do phase.monad [[_ varT] (//type.with-env check.var) _ (//type.with-env (check.check varT variantT))] (//type.with-type varT - (/.sum _primitive.phase choice valueC))) - (///.run _primitive.state) + (/.sum _primitive.phase choice archive.empty valueC))) + (phase.run _primitive.state) (case> (^ (#try.Success (////analysis.variant variant))) (check-sum' choice size variant) _ false))) (_.test "Cannot analyse through unbound type-vars." - (|> (do ///.monad + (|> (do phase.monad [[_ varT] (//type.with-env check.var)] (//type.with-type varT - (/.sum _primitive.phase choice valueC))) + (/.sum _primitive.phase choice archive.empty valueC))) check-fails)) (_.test "Can analyse through existential quantification." (|> (//type.with-type (type.ex-q 1 +variantT) - (/.sum _primitive.phase +choice +valueC)) + (/.sum _primitive.phase +choice archive.empty +valueC)) check-succeeds)) (_.test "Can analyse through universal quantification." (let [check-outcome (if (not (n.= choice +choice)) check-succeeds check-fails)] (|> (//type.with-type (type.univ-q 1 +variantT) - (/.sum _primitive.phase +choice +valueC)) + (/.sum _primitive.phase +choice archive.empty +valueC)) check-outcome))) )))) @@ -180,8 +184,8 @@ ($_ _.and (_.test "Can analyse." (|> (//type.with-type tupleT - (/.product _primitive.phase (list@map product.right primitives))) - (///.run _primitive.state) + (/.product archive.empty _primitive.phase (list@map product.right primitives))) + (phase.run _primitive.state) (case> (#try.Success tupleA) (correct-size? size tupleA) @@ -189,8 +193,8 @@ false))) (_.test "Can infer." (|> (//type.with-inference - (/.product _primitive.phase (list@map product.right primitives))) - (///.run _primitive.state) + (/.product archive.empty _primitive.phase (list@map product.right primitives))) + (phase.run _primitive.state) (case> (#try.Success [_type tupleA]) (and (check.checks? tupleT _type) (correct-size? size tupleA)) @@ -199,16 +203,16 @@ false))) (_.test "Can analyse singleton." (|> (//type.with-type singletonT - (_primitive.phase (` [(~ singletonC)]))) + (_primitive.phase archive.empty (` [(~ singletonC)]))) check-succeeds)) (_.test "Can analyse through bound type-vars." - (|> (do ///.monad + (|> (do phase.monad [[_ varT] (//type.with-env check.var) _ (//type.with-env (check.check varT (type.tuple (list@map product.left primitives))))] (//type.with-type varT - (/.product _primitive.phase (list@map product.right primitives)))) - (///.run _primitive.state) + (/.product archive.empty _primitive.phase (list@map product.right primitives)))) + (phase.run _primitive.state) (case> (#try.Success tupleA) (correct-size? size tupleA) @@ -216,11 +220,11 @@ false))) (_.test "Can analyse through existential quantification." (|> (//type.with-type (type.ex-q 1 +tupleT) - (/.product _primitive.phase (list@map product.right +primitives))) + (/.product archive.empty _primitive.phase (list@map product.right +primitives))) check-succeeds)) (_.test "Cannot analyse through universal quantification." (|> (//type.with-type (type.univ-q 1 +tupleT) - (/.product _primitive.phase (list@map product.right +primitives))) + (/.product archive.empty _primitive.phase (list@map product.right +primitives))) check-fails)) )))) @@ -248,23 +252,23 @@ (<| (_.context (%.name (name-of /.tagged-sum))) ($_ _.and (_.test "Can infer." - (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC) + (|> (/.tagged-sum _primitive.phase [module-name choice-tag] archive.empty choiceC) (check-variant module-name tags monoT (with-name monoT) choice))) (_.test "Inference retains universal quantification when type-vars are not bound." - (|> (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC) + (|> (/.tagged-sum _primitive.phase [module-name other-choice-tag] archive.empty other-choiceC) (check-variant module-name tags polyT (with-name polyT) other-choice))) (_.test "Can specialize." (|> (//type.with-type monoT - (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC)) + (/.tagged-sum _primitive.phase [module-name other-choice-tag] archive.empty other-choiceC)) (check-variant module-name tags monoT (with-name polyT) other-choice))) (_.test "Specialization when type-vars get bound." - (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC) + (|> (/.tagged-sum _primitive.phase [module-name choice-tag] archive.empty choiceC) (check-variant module-name tags monoT (with-name polyT) choice))) @@ -291,7 +295,7 @@ (#.Named [module-name type-name]))]] (<| (_.context (%.name (name-of /.record))) (_.test "Can infer." - (|> (/.record _primitive.phase recordC) + (|> (/.record archive.empty _primitive.phase recordC) (check-record module-name tags monoT monoT size)))))) (def: #export test diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index df4e5a7e5..a7686e0f2 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -1,6 +1,7 @@ (.module: [lux (#- i64 int primitive) - [abstract ["." monad (#+ do)]] + [abstract + ["." monad (#+ do)]] [data ["%" text/format (#+ format)] ["." name]] @@ -22,18 +23,22 @@ ["_." primitive]]] {1 ["." / - ["///#" //// + ["///#" //// #_ [analysis ["#." scope] - ["#." type]]]]}) + ["#." type]] + [//// + ["." phase] + [meta + ["." archive]]]]]}) (template [<name> <success> <failure>] [(def: (<name> procedure params output-type) (-> Text (List Code) Type Bit) (|> (////scope.with-scope "" (////type.with-type output-type - (_primitive.phase (` ((~ (code.text procedure)) (~+ params)))))) - (////.run _primitive.state) + (_primitive.phase archive.empty (` ((~ (code.text procedure)) (~+ params)))))) + (phase.run _primitive.state) (case> (#try.Success _) <success> diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux index da9937862..da9937862 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 263f5e4a7..5f9f14321 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -15,13 +15,17 @@ {1 ["." / ["/#" // - ["/#" // + ["/#" // #_ [extension ["#." bundle]] ["/#" // - ["#." reference] ["#." analysis (#+ Branch Analysis)] - ["#." synthesis (#+ Synthesis)]]]]]}) + ["#." synthesis (#+ Synthesis)] + [/// + ["#." reference] + ["." phase] + [meta + ["." archive]]]]]]]}) (def: dummy-vars Test @@ -35,8 +39,8 @@ (list)]])]] (_.test "Dummy variables created to mask expressions get eliminated during synthesis." (|> maskA - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (try@map (//primitive.corresponds? maskedA)) (try.default false))))) @@ -53,8 +57,8 @@ (list)]])]] (_.test "Can detect and reify simple 'let' expressions." (|> letA - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS]))) (and (n.= registerA registerS) (//primitive.corresponds? inputA inputS) @@ -81,8 +85,8 @@ (////analysis.control/case [inputA [elseB (list thenB)]]))]] (_.test "Can detect and reify simple 'if' expressions." (|> ifA - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS]))) (and (//primitive.corresponds? inputA inputS) (//primitive.corresponds? thenA thenS) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 1a4993c92..799a8a526 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -1,6 +1,7 @@ (.module: [lux #* - [abstract ["." monad (#+ do)]] + [abstract + ["." monad (#+ do)]] [data ["." name]] ["r" math/random (#+ Random) ("#@." monad)] @@ -22,14 +23,18 @@ {1 ["." / ["/#" // - ["/#" // + ["/#" // #_ [extension ["#." bundle]] ["/#" // - [arity (#+ Arity)] - ["#." reference (#+ Variable) ("variable@." equivalence)] ["#." analysis (#+ Analysis)] - ["#." synthesis (#+ Synthesis)]]]]]}) + ["#." synthesis (#+ Synthesis)] + [/// + [arity (#+ Arity)] + ["#." reference (#+ Variable) ("variable@." equivalence)] + ["." phase] + [meta + ["." archive]]]]]]]}) (def: constant-function (Random [Arity Analysis Analysis]) @@ -117,8 +122,8 @@ ($_ _.and (_.test "Nested functions will get folded together." (|> function//constant - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (^ (#try.Success (////synthesis.function/abstraction [environment arity output]))) (and (n.= arity//constant arity) (//primitive.corresponds? prediction//constant output)) @@ -127,8 +132,8 @@ (n.= 0 arity//constant)))) (_.test "Folded functions provide direct access to environment variables." (|> function//environment - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (^ (#try.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))]))) (and (n.= arity//environment arity) (variable@= prediction//environment output)) @@ -137,8 +142,8 @@ #0))) (_.test "Folded functions properly offset local variables." (|> function//local - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (^ (#try.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))]))) (and (n.= arity//local arity) (variable@= prediction//local output)) @@ -156,8 +161,8 @@ ($_ _.and (_.test "Can synthesize function application." (|> (////analysis.apply [funcA argsA]) - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (^ (#try.Success (////synthesis.function/apply [funcS argsS]))) (and (//primitive.corresponds? funcA funcS) (list.every? (product.uncurry //primitive.corresponds?) @@ -167,8 +172,8 @@ #0))) (_.test "Function application on no arguments just synthesizes to the function itself." (|> (////analysis.apply [funcA (list)]) - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (#try.Success funcS) (//primitive.corresponds? funcA funcS) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index d9d24ea21..cd7fe54eb 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -12,12 +12,16 @@ {1 ["." / #_ ["/#" // - ["/#" // + ["/#" // #_ [extension ["#." bundle]] ["/#" // ["#." analysis (#+ Analysis)] - ["#." synthesis (#+ Synthesis)]]]]]}) + ["#." synthesis (#+ Synthesis)] + [/// + ["." phase] + [meta + ["." archive]]]]]]]}) (def: #export primitive (Random Analysis) @@ -63,8 +67,8 @@ [expected <generator>] (_.test (%.name (name-of <synthesis>)) (|> (#////analysis.Primitive (<analysis> expected)) - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (#try.Success (#////synthesis.Primitive (<synthesis> actual))) (is? expected actual) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux index d59065782..7dea796fc 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux @@ -21,12 +21,16 @@ {1 ["." / #_ ["/#" // - ["/#" // + ["/#" // #_ [extension ["#." bundle]] ["/#" // ["#." analysis (#+ Analysis)] - ["#." synthesis (#+ Synthesis)]]]]]}) + ["#." synthesis (#+ Synthesis)] + [/// + ["." phase] + [meta + ["." archive]]]]]]]}) (def: variant Test @@ -40,8 +44,8 @@ memberA //primitive.primitive] (_.test "Can synthesize variants." (|> (////analysis.variant [lefts right? memberA]) - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (^ (#try.Success (////synthesis.variant [leftsS right?S valueS]))) (let [tagS (if right?S (inc leftsS) leftsS)] (and (n.= tagA tagS) @@ -58,8 +62,8 @@ membersA (r.list size //primitive.primitive)] (_.test "Can synthesize tuple." (|> (////analysis.tuple membersA) - //.phase - (///.run [///bundle.empty ////synthesis.init]) + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) (case> (^ (#try.Success (////synthesis.tuple membersS))) (and (n.= size (list.size membersS)) (list.every? (product.uncurry //primitive.corresponds?) diff --git a/stdlib/source/test/lux/tool/compiler/default/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index 4baa57891..103dc069e 100644 --- a/stdlib/source/test/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -91,7 +91,7 @@ (:: code.equivalence = parsed sample))) (do @ [other code^] - (_.test "Can parse Lux multiple code nodes." + (_.test "Can parse multiple Lux code nodes." (let [source-code (format (%.code sample) " " (%.code other)) source-code//size (text.size source-code)] (case (/.parse "" (dictionary.new text.hash) source-code//size |