aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2018-08-11 10:00:48 -0400
committerEduardo Julian2018-08-11 10:00:48 -0400
commit13265c95fcacf9952bc61ebece64078d8b6124ec (patch)
treeb29a84b32778e6d3f5fca37298b270ad2e20abee
parent84d7f9ccef221e9797929813af1094b335ba26e9 (diff)
Got stdlib tests to compile again.
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/case.lux2
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/function.lux22
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux19
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux4
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux12
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux52
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)))
))))