diff options
Diffstat (limited to '')
6 files changed, 59 insertions, 52 deletions
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux index abe199241..2b9cfa914 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux @@ -168,7 +168,7 @@ (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))] [_pattern heterogeneousC])) (list.drop (inc heterogeneous-idx) exhaustive-branchesC))) - analyse-pm (|>> (/.case _primitive.analyse inputC) + analyse-pm (|>> (/.case _primitive.phase inputC) (typeA.with-type outputT) analysis.with-scope (do phase.Monad<Operation> diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux index 5cf5b232a..e9d1c6f8e 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux @@ -36,7 +36,7 @@ (-> Type Nat (Operation Analysis) Bit) (|> analysis (typeA.with-type expectedT) - (phase.run [analysisE.bundle (init.compiler [])]) + (phase.run _primitive.state) (case> (#e.Success applyA) (let [[funcA argsA] (analysis.application applyA)] (n/= num-args (list.size argsA))) @@ -55,21 +55,21 @@ ($_ seq (test "Can analyse function." (and (|> (typeA.with-type (All [a] (-> a outputT)) - (/.function _primitive.analyse func-name arg-name outputC)) + (/.function _primitive.phase func-name arg-name outputC)) _structure.check-succeeds) (|> (typeA.with-type (All [a] (-> a a)) - (/.function _primitive.analyse func-name arg-name g!arg)) + (/.function _primitive.phase func-name arg-name g!arg)) _structure.check-succeeds))) (test "Generic functions can always be specialized." (and (|> (typeA.with-type (-> inputT outputT) - (/.function _primitive.analyse func-name arg-name outputC)) + (/.function _primitive.phase func-name arg-name outputC)) _structure.check-succeeds) (|> (typeA.with-type (-> inputT inputT) - (/.function _primitive.analyse func-name arg-name g!arg)) + (/.function _primitive.phase func-name arg-name g!arg)) _structure.check-succeeds))) (test "The function's name is bound to the function's type." (|> (typeA.with-type (Rec self (-> inputT self)) - (/.function _primitive.analyse func-name arg-name (code.local-identifier func-name))) + (/.function _primitive.phase func-name arg-name (code.local-identifier func-name))) _structure.check-succeeds)) )))) @@ -101,18 +101,18 @@ dummy-function (#analysis.Function (list) (#analysis.Reference (reference.local 1)))]] ($_ seq (test "Can analyse monomorphic type application." - (|> (/.apply _primitive.analyse funcT dummy-function inputsC) + (|> (/.apply _primitive.phase funcT dummy-function inputsC) (check-apply outputT full-args))) (test "Can partially apply functions." - (|> (/.apply _primitive.analyse funcT dummy-function (list.take partial-args inputsC)) + (|> (/.apply _primitive.phase funcT dummy-function (list.take partial-args inputsC)) (check-apply partialT partial-args))) (test "Can apply polymorphic functions." - (|> (/.apply _primitive.analyse polyT dummy-function inputsC) + (|> (/.apply _primitive.phase polyT dummy-function inputsC) (check-apply poly-inputT full-args))) (test "Polymorphic partial application propagates found type-vars." - (|> (/.apply _primitive.analyse polyT dummy-function (list.take (inc var-idx) inputsC)) + (|> (/.apply _primitive.phase polyT dummy-function (list.take (inc var-idx) inputsC)) (check-apply partial-polyT1 (inc var-idx)))) (test "Polymorphic partial application preserves quantification for type-vars." - (|> (/.apply _primitive.analyse polyT dummy-function (list.take var-idx inputsC)) + (|> (/.apply _primitive.phase polyT dummy-function (list.take var-idx inputsC)) (check-apply partial-polyT2 var-idx))) )))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux index 85e5660b0..6a64cc206 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux @@ -16,7 +16,8 @@ [compiler [default ["." init] - ["." phase (#+ Eval) + [evaluation (#+ Eval)] + ["." phase ["." analysis (#+ Analysis Operation) [".A" type] ["." expression]] @@ -24,7 +25,13 @@ [".E" analysis]]]]] test]) -(def: #export analyse (expression.analyser (:coerce Eval []))) +(def: #export phase + analysis.Phase + expression.compile) + +(def: #export state + analysis.State+ + [(analysisE.bundle (:coerce Eval [])) (init.compiler [])]) (def: unit (r.Random Code) @@ -37,7 +44,7 @@ [(r.and (random/wrap <type>) (random/map <code-wrapper> <value-gen>))] [Any code.tuple (r.list 0 ..unit)] - [Bit code.bit r.bit] + [Bit code.bit r.bit] [Nat code.nat r.nat] [Int code.int r.int] [Rev code.rev r.rev] @@ -53,7 +60,7 @@ (-> Type (Operation Analysis) (e.Error Analysis)) (|> analysis typeA.with-inference - (phase.run [analysisE.bundle (init.compiler [])]) + (phase.run ..state) (case> (#e.Success [inferred-type output]) (if (is? expected-type inferred-type) (#e.Success output) @@ -65,7 +72,7 @@ (context: "Primitives" ($_ seq (test "Can analyse unit." - (|> (infer-primitive Any (..analyse (' []))) + (|> (infer-primitive Any (..phase (' []))) (case> (^ (#e.Success (#analysis.Primitive (#analysis.Unit output)))) (is? [] output) @@ -77,7 +84,7 @@ [(do @ [sample <random>] (test (format "Can analyse " <desc> ".") - (|> (infer-primitive <type> (..analyse (<constructor> sample))) + (|> (infer-primitive <type> (..phase (<constructor> sample))) (case> (#e.Success (#analysis.Primitive (<tag> output))) (is? sample output) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index 20eeaf2eb..fc082155a 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -34,8 +34,8 @@ (-> Text (List Code) Type Bit) (|> (scope.with-scope "" (typeA.with-type output-type - (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))) - (phase.run [analysisE.bundle (init.compiler [])]) + (_primitive.phase (` ((~ (code.text procedure)) (~+ params)))))) + (phase.run _primitive.state) (case> (#e.Success _) <success> diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux index a78d1b236..8aed9e39b 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux @@ -58,8 +58,8 @@ (module.import def-module) (wrap []))] (typeA.with-inference - (_primitive.analyse (code.identifier [def-module var-name])))))) - (phase.run [analysisE.bundle (init.compiler [])]) + (_primitive.phase (code.identifier [def-module var-name])))))) + (phase.run _primitive.state) check!)) (context: "References" @@ -76,8 +76,8 @@ (|> (scope.with-scope scope-name (scope.with-local [var-name expectedT] (typeA.with-inference - (_primitive.analyse (code.local-identifier var-name))))) - (phase.run [analysisE.bundle (init.compiler [])]) + (_primitive.phase (code.local-identifier var-name))))) + (phase.run _primitive.state) (case> (^ (#e.Success [inferredT (#analysis.Reference (reference.local var))])) (and (type/= expectedT inferredT) (n/= 0 var)) @@ -89,9 +89,9 @@ (|> (do phase.Monad<Operation> [_ (module.define var-name [expectedT (' {}) []])] (typeA.with-inference - (_primitive.analyse (code.identifier def-name)))) + (_primitive.phase (code.identifier def-name)))) (module.with-module 0 def-module) - (phase.run [analysisE.bundle (init.compiler [])]) + (phase.run _primitive.state) (case> (^ (#e.Success [_ inferredT (#analysis.Reference (reference.constant constant-name))])) (and (type/= expectedT inferredT) (name/= def-name constant-name)) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux index 92f92e54e..9a17deaec 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux @@ -36,7 +36,7 @@ (do-template [<name> <on-success> <on-error>] [(def: #export <name> (All [a] (-> (Operation a) Bit)) - (|>> (phase.run [analysisE.bundle (init.compiler [])]) + (|>> (phase.run _primitive.state) (case> (#e.Success _) <on-success> @@ -60,7 +60,7 @@ (-> Type Nat Tag (Operation Analysis) Bit) (|> analysis (typeA.with-type type) - (phase.run [analysisE.bundle (init.compiler [])]) + (phase.run _primitive.state) (case> (^multi (#e.Success sumA) [(analysis.variant sumA) (#.Some variant)]) @@ -80,7 +80,7 @@ (|> analysis (tagged module tags type) (typeA.with-type type) - (phase.run [analysisE.bundle (init.compiler [])]) + (phase.run _primitive.state) (case> (^multi (#e.Success [_ sumA]) [(analysis.variant sumA) (#.Some variant)]) @@ -97,7 +97,7 @@ (-> Text (List module.Tag) Type Nat (Operation [Type Analysis]) Bit) (|> analysis (tagged module tags type) - (phase.run [analysisE.bundle (init.compiler [])]) + (phase.run _primitive.state) (case> (#e.Success [_ productT productA]) (and (type/= type productT) (right-size? size productA)) @@ -124,15 +124,15 @@ ($_ seq (test "Can analyse sum." (check-sum variantT size choice - (/.sum _primitive.analyse choice valueC))) + (/.sum _primitive.phase choice valueC))) (test "Can analyse sum through bound type-vars." (|> (do phase.Monad<Operation> [[_ varT] (typeA.with-env check.var) _ (typeA.with-env (check.check varT variantT))] (typeA.with-type varT - (/.sum _primitive.analyse choice valueC))) - (phase.run [analysisE.bundle (init.compiler [])]) + (/.sum _primitive.phase choice valueC))) + (phase.run _primitive.state) (case> (^multi (#e.Success sumA) [(analysis.variant sumA) (#.Some variant)]) @@ -144,18 +144,18 @@ (|> (do phase.Monad<Operation> [[_ varT] (typeA.with-env check.var)] (typeA.with-type varT - (/.sum _primitive.analyse choice valueC))) + (/.sum _primitive.phase choice valueC))) check-fails)) (test "Can analyse sum through existential quantification." (|> (typeA.with-type (type.ex-q 1 +variantT) - (/.sum _primitive.analyse +choice +valueC)) + (/.sum _primitive.phase +choice +valueC)) check-succeeds)) (test "Can analyse sum through universal quantification." (let [check-outcome (if (not (n/= choice +choice)) check-succeeds check-fails)] (|> (typeA.with-type (type.univ-q 1 +variantT) - (/.sum _primitive.analyse +choice +valueC)) + (/.sum _primitive.phase +choice +valueC)) check-outcome))) )))) @@ -175,8 +175,8 @@ ($_ seq (test "Can analyse product." (|> (typeA.with-type tupleT - (/.product _primitive.analyse (list/map product.right primitives))) - (phase.run [analysisE.bundle (init.compiler [])]) + (/.product _primitive.phase (list/map product.right primitives))) + (phase.run _primitive.state) (case> (#e.Success tupleA) (right-size? size tupleA) @@ -184,8 +184,8 @@ #0))) (test "Can infer product." (|> (typeA.with-inference - (/.product _primitive.analyse (list/map product.right primitives))) - (phase.run [analysisE.bundle (init.compiler [])]) + (/.product _primitive.phase (list/map product.right primitives))) + (phase.run _primitive.state) (case> (#e.Success [_type tupleA]) (and (type/= tupleT _type) (right-size? size tupleA)) @@ -194,7 +194,7 @@ #0))) (test "Can analyse pseudo-product (singleton tuple)" (|> (typeA.with-type singletonT - (_primitive.analyse (` [(~ singletonC)]))) + (_primitive.phase (` [(~ singletonC)]))) check-succeeds)) (test "Can analyse product through bound type-vars." (|> (do phase.Monad<Operation> @@ -202,8 +202,8 @@ _ (typeA.with-env (check.check varT (type.tuple (list/map product.left primitives))))] (typeA.with-type varT - (/.product _primitive.analyse (list/map product.right primitives)))) - (phase.run [analysisE.bundle (init.compiler [])]) + (/.product _primitive.phase (list/map product.right primitives)))) + (phase.run _primitive.state) (case> (#e.Success tupleA) (right-size? size tupleA) @@ -211,11 +211,11 @@ #0))) (test "Can analyse product through existential quantification." (|> (typeA.with-type (type.ex-q 1 +tupleT) - (/.product _primitive.analyse (list/map product.right +primitives))) + (/.product _primitive.phase (list/map product.right +primitives))) check-succeeds)) (test "Cannot analyse product through universal quantification." (|> (typeA.with-type (type.univ-q 1 +tupleT) - (/.product _primitive.analyse (list/map product.right +primitives))) + (/.product _primitive.phase (list/map product.right +primitives))) check-fails)) )))) @@ -244,17 +244,17 @@ other-choice-tag (maybe.assume (list.nth other-choice tags))]] ($_ seq (test "Can infer tagged sum." - (|> (/.tagged-sum _primitive.analyse [module-name choice-tag] choiceC) + (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC) (check-variant module-name tags namedT choice size))) (test "Tagged sums specialize when type-vars get bound." - (|> (/.tagged-sum _primitive.analyse [module-name choice-tag] choiceC) + (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC) (check-variant module-name tags named-polyT choice size))) (test "Tagged sum inference retains universal quantification when type-vars are not bound." - (|> (/.tagged-sum _primitive.analyse [module-name other-choice-tag] other-choiceC) + (|> (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC) (check-variant module-name tags named-polyT other-choice size))) (test "Can specialize generic tagged sums." (|> (typeA.with-type variantT - (/.tagged-sum _primitive.analyse [module-name other-choice-tag] other-choiceC)) + (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC)) (check-variant module-name tags named-polyT other-choice size))) )))) @@ -282,16 +282,16 @@ ($_ seq (test "Can infer record." (|> (typeA.with-inference - (/.record _primitive.analyse recordC)) + (/.record _primitive.phase recordC)) (check-record-inference module-name tags namedT size))) (test "Records specialize when type-vars get bound." (|> (typeA.with-inference - (/.record _primitive.analyse recordC)) + (/.record _primitive.phase recordC)) (check-record-inference module-name tags named-polyT size))) (test "Can specialize generic records." (|> (do phase.Monad<Operation> [recordA (typeA.with-type tupleT - (/.record _primitive.analyse recordC))] + (/.record _primitive.phase recordC))] (wrap [tupleT recordA])) (check-record-inference module-name tags named-polyT size))) )))) |