diff options
Diffstat (limited to 'stdlib/test')
4 files changed, 37 insertions, 43 deletions
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 ba84d926f..5cf5b232a 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux @@ -17,7 +17,7 @@ ["." macro ["." code]] [compiler - ["." default + [default ["." reference] ["." init] ["." phase @@ -32,8 +32,6 @@ ["_." primitive] ["_." structure]]) -(def: analyse (expression.analyser (:coerce default.Eval []))) - (def: (check-apply expectedT num-args analysis) (-> Type Nat (Operation Analysis) Bit) (|> analysis @@ -57,21 +55,21 @@ ($_ seq (test "Can analyse function." (and (|> (typeA.with-type (All [a] (-> a outputT)) - (/.function ..analyse func-name arg-name outputC)) + (/.function _primitive.analyse func-name arg-name outputC)) _structure.check-succeeds) (|> (typeA.with-type (All [a] (-> a a)) - (/.function ..analyse func-name arg-name g!arg)) + (/.function _primitive.analyse func-name arg-name g!arg)) _structure.check-succeeds))) (test "Generic functions can always be specialized." (and (|> (typeA.with-type (-> inputT outputT) - (/.function ..analyse func-name arg-name outputC)) + (/.function _primitive.analyse func-name arg-name outputC)) _structure.check-succeeds) (|> (typeA.with-type (-> inputT inputT) - (/.function ..analyse func-name arg-name g!arg)) + (/.function _primitive.analyse 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 ..analyse func-name arg-name (code.local-identifier func-name))) + (/.function _primitive.analyse func-name arg-name (code.local-identifier func-name))) _structure.check-succeeds)) )))) @@ -103,18 +101,18 @@ dummy-function (#analysis.Function (list) (#analysis.Reference (reference.local 1)))]] ($_ seq (test "Can analyse monomorphic type application." - (|> (/.apply ..analyse funcT dummy-function inputsC) + (|> (/.apply _primitive.analyse funcT dummy-function inputsC) (check-apply outputT full-args))) (test "Can partially apply functions." - (|> (/.apply ..analyse funcT dummy-function (list.take partial-args inputsC)) + (|> (/.apply _primitive.analyse funcT dummy-function (list.take partial-args inputsC)) (check-apply partialT partial-args))) (test "Can apply polymorphic functions." - (|> (/.apply ..analyse polyT dummy-function inputsC) + (|> (/.apply _primitive.analyse polyT dummy-function inputsC) (check-apply poly-inputT full-args))) (test "Polymorphic partial application propagates found type-vars." - (|> (/.apply ..analyse polyT dummy-function (list.take (inc var-idx) inputsC)) + (|> (/.apply _primitive.analyse 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 ..analyse polyT dummy-function (list.take var-idx inputsC)) + (|> (/.apply _primitive.analyse 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 1d807e519..85e5660b0 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux @@ -14,9 +14,9 @@ [macro ["." code]] [compiler - ["." default + [default ["." init] - ["." phase + ["." phase (#+ Eval) ["." analysis (#+ Analysis Operation) [".A" type] ["." expression]] @@ -24,7 +24,7 @@ [".E" analysis]]]]] test]) -(def: #export analyse (expression.analyser (:coerce default.Eval []))) +(def: #export analyse (expression.analyser (:coerce Eval []))) (def: unit (r.Random Code) 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 dae6d916b..a78d1b236 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux @@ -13,7 +13,7 @@ [macro ["." code]] [compiler - ["." default + [default ["." reference] ["." init] ["." phase @@ -28,8 +28,6 @@ [// ["_." primitive]]) -(def: analyse (expression.analyser (:coerce default.Eval []))) - (type: Check (-> (e.Error Any) Bit)) (do-template [<name> <on-success> <on-failure>] @@ -60,7 +58,7 @@ (module.import def-module) (wrap []))] (typeA.with-inference - (..analyse (code.identifier [def-module var-name])))))) + (_primitive.analyse (code.identifier [def-module var-name])))))) (phase.run [analysisE.bundle (init.compiler [])]) check!)) @@ -78,7 +76,7 @@ (|> (scope.with-scope scope-name (scope.with-local [var-name expectedT] (typeA.with-inference - (..analyse (code.local-identifier var-name))))) + (_primitive.analyse (code.local-identifier var-name))))) (phase.run [analysisE.bundle (init.compiler [])]) (case> (^ (#e.Success [inferredT (#analysis.Reference (reference.local var))])) (and (type/= expectedT inferredT) @@ -91,7 +89,7 @@ (|> (do phase.Monad<Operation> [_ (module.define var-name [expectedT (' {}) []])] (typeA.with-inference - (..analyse (code.identifier def-name)))) + (_primitive.analyse (code.identifier def-name)))) (module.with-module 0 def-module) (phase.run [analysisE.bundle (init.compiler [])]) (case> (^ (#e.Success [_ inferredT (#analysis.Reference (reference.constant 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 d36bffe20..92f92e54e 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux @@ -19,7 +19,7 @@ [macro ["." code]] [compiler - ["." default + [default ["." init] ["." phase ["." analysis (#+ Analysis Variant Tag Operation) @@ -33,8 +33,6 @@ [// ["_." primitive]]) -(def: analyse (expression.analyser (:coerce default.Eval []))) - (do-template [<name> <on-success> <on-error>] [(def: #export <name> (All [a] (-> (Operation a) Bit)) @@ -126,14 +124,14 @@ ($_ seq (test "Can analyse sum." (check-sum variantT size choice - (/.sum ..analyse choice valueC))) + (/.sum _primitive.analyse 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 ..analyse choice valueC))) + (/.sum _primitive.analyse choice valueC))) (phase.run [analysisE.bundle (init.compiler [])]) (case> (^multi (#e.Success sumA) [(analysis.variant sumA) @@ -146,18 +144,18 @@ (|> (do phase.Monad<Operation> [[_ varT] (typeA.with-env check.var)] (typeA.with-type varT - (/.sum ..analyse choice valueC))) + (/.sum _primitive.analyse choice valueC))) check-fails)) (test "Can analyse sum through existential quantification." (|> (typeA.with-type (type.ex-q 1 +variantT) - (/.sum ..analyse +choice +valueC)) + (/.sum _primitive.analyse +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 ..analyse +choice +valueC)) + (/.sum _primitive.analyse +choice +valueC)) check-outcome))) )))) @@ -177,7 +175,7 @@ ($_ seq (test "Can analyse product." (|> (typeA.with-type tupleT - (/.product ..analyse (list/map product.right primitives))) + (/.product _primitive.analyse (list/map product.right primitives))) (phase.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success tupleA) (right-size? size tupleA) @@ -186,7 +184,7 @@ #0))) (test "Can infer product." (|> (typeA.with-inference - (/.product ..analyse (list/map product.right primitives))) + (/.product _primitive.analyse (list/map product.right primitives))) (phase.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success [_type tupleA]) (and (type/= tupleT _type) @@ -196,7 +194,7 @@ #0))) (test "Can analyse pseudo-product (singleton tuple)" (|> (typeA.with-type singletonT - (..analyse (` [(~ singletonC)]))) + (_primitive.analyse (` [(~ singletonC)]))) check-succeeds)) (test "Can analyse product through bound type-vars." (|> (do phase.Monad<Operation> @@ -204,7 +202,7 @@ _ (typeA.with-env (check.check varT (type.tuple (list/map product.left primitives))))] (typeA.with-type varT - (/.product ..analyse (list/map product.right primitives)))) + (/.product _primitive.analyse (list/map product.right primitives)))) (phase.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success tupleA) (right-size? size tupleA) @@ -213,11 +211,11 @@ #0))) (test "Can analyse product through existential quantification." (|> (typeA.with-type (type.ex-q 1 +tupleT) - (/.product ..analyse (list/map product.right +primitives))) + (/.product _primitive.analyse (list/map product.right +primitives))) check-succeeds)) (test "Cannot analyse product through universal quantification." (|> (typeA.with-type (type.univ-q 1 +tupleT) - (/.product ..analyse (list/map product.right +primitives))) + (/.product _primitive.analyse (list/map product.right +primitives))) check-fails)) )))) @@ -246,17 +244,17 @@ other-choice-tag (maybe.assume (list.nth other-choice tags))]] ($_ seq (test "Can infer tagged sum." - (|> (/.tagged-sum ..analyse [module-name choice-tag] choiceC) + (|> (/.tagged-sum _primitive.analyse [module-name choice-tag] choiceC) (check-variant module-name tags namedT choice size))) (test "Tagged sums specialize when type-vars get bound." - (|> (/.tagged-sum ..analyse [module-name choice-tag] choiceC) + (|> (/.tagged-sum _primitive.analyse [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 ..analyse [module-name other-choice-tag] other-choiceC) + (|> (/.tagged-sum _primitive.analyse [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 ..analyse [module-name other-choice-tag] other-choiceC)) + (/.tagged-sum _primitive.analyse [module-name other-choice-tag] other-choiceC)) (check-variant module-name tags named-polyT other-choice size))) )))) @@ -284,16 +282,16 @@ ($_ seq (test "Can infer record." (|> (typeA.with-inference - (/.record ..analyse recordC)) + (/.record _primitive.analyse recordC)) (check-record-inference module-name tags namedT size))) (test "Records specialize when type-vars get bound." (|> (typeA.with-inference - (/.record ..analyse recordC)) + (/.record _primitive.analyse 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 ..analyse recordC))] + (/.record _primitive.analyse recordC))] (wrap [tupleT recordA])) (check-record-inference module-name tags named-polyT size))) )))) |