From 17d5280a5e05c70cdb0b2cf44606c186b000c7c1 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 6 Feb 2018 22:54:57 -0400
Subject: - Fixed the remaining broken tests in new-luxc.
---
new-luxc/test/test/luxc/lang/analysis/function.lux | 57 +++++++-----------
.../test/luxc/lang/analysis/procedure/common.lux | 69 +++++++---------------
.../test/test/luxc/lang/analysis/structure.lux | 25 ++++----
.../test/test/luxc/lang/translation/jvm/case.lux | 19 +++---
4 files changed, 65 insertions(+), 105 deletions(-)
(limited to 'new-luxc/test')
diff --git a/new-luxc/test/test/luxc/lang/analysis/function.lux b/new-luxc/test/test/luxc/lang/analysis/function.lux
index 3f8a17505..62d5ad93c 100644
--- a/new-luxc/test/test/luxc/lang/analysis/function.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/function.lux
@@ -52,13 +52,13 @@
[analysis (list)]))
(def: (check-apply expectedT num-args analysis)
- (-> Type Nat (Meta [Type la.Analysis]) Bool)
+ (-> Type Nat (Meta la.Analysis) Bool)
(|> analysis
+ (&.with-type expectedT)
(macro.run (init-compiler []))
- (case> (#e.Success [applyT applyA])
+ (case> (#e.Success applyA)
(let [[funcA argsA] (flatten-apply applyA)]
- (and (type/= expectedT applyT)
- (n/= num-args (list.size argsA))))
+ (n/= num-args (list.size argsA)))
(#e.Error error)
false)))
@@ -69,35 +69,30 @@
[func-name (r.text +5)
arg-name (|> (r.text +5) (r.filter (|>> (text/= func-name) not)))
[outputT outputC] gen-primitive
- [inputT _] gen-primitive]
+ [inputT _] gen-primitive
+ #let [g!arg (code.local-symbol arg-name)]]
($_ seq
(test "Can analyse function."
- (|> (&.with-type (type (All [a] (-> a outputT)))
- (@.analyse-function analyse func-name arg-name outputC))
- (macro.run (init-compiler []))
- succeeds?))
+ (and (|> (&.with-type (All [a] (-> a outputT))
+ (@.analyse-function analyse func-name arg-name outputC))
+ (macro.run (init-compiler []))
+ succeeds?)
+ (|> (&.with-type (All [a] (-> a a))
+ (@.analyse-function analyse func-name arg-name g!arg))
+ (macro.run (init-compiler []))
+ succeeds?)))
(test "Generic functions can always be specialized."
(and (|> (&.with-type (-> inputT outputT)
(@.analyse-function analyse func-name arg-name outputC))
(macro.run (init-compiler []))
succeeds?)
(|> (&.with-type (-> inputT inputT)
- (@.analyse-function analyse func-name arg-name (code.symbol ["" arg-name])))
+ (@.analyse-function analyse func-name arg-name g!arg))
(macro.run (init-compiler []))
succeeds?)))
- (test "Can infer function (constant output and unused input)."
- (|> (@common.with-unknown-type
- (@.analyse-function analyse func-name arg-name outputC))
- (macro.run (init-compiler []))
- (check-type (type (All [a] (-> a outputT))))))
- (test "Can infer function (output = input)."
- (|> (@common.with-unknown-type
- (@.analyse-function analyse func-name arg-name (code.symbol ["" arg-name])))
- (macro.run (init-compiler []))
- (check-type (type (All [a] (-> a a))))))
(test "The function's name is bound to the function's type."
- (|> (&.with-type (type (Rec self (-> inputT self)))
- (@.analyse-function analyse func-name arg-name (code.symbol ["" func-name])))
+ (|> (&.with-type (Rec self (-> inputT self))
+ (@.analyse-function analyse func-name arg-name (code.local-symbol func-name)))
(macro.run (init-compiler []))
succeeds?))
))))
@@ -129,26 +124,18 @@
varT)]]
($_ seq
(test "Can analyse monomorphic type application."
- (|> (@common.with-unknown-type
- (@.analyse-apply analyse funcT (' []) inputsC))
+ (|> (@.analyse-apply analyse funcT (' []) inputsC)
(check-apply outputT full-args)))
(test "Can partially apply functions."
- (|> (@common.with-unknown-type
- (@.analyse-apply analyse funcT (' [])
- (list.take partial-args inputsC)))
+ (|> (@.analyse-apply analyse funcT (' []) (list.take partial-args inputsC))
(check-apply partialT partial-args)))
(test "Can apply polymorphic functions."
- (|> (@common.with-unknown-type
- (@.analyse-apply analyse polyT (' []) inputsC))
+ (|> (@.analyse-apply analyse polyT (' []) inputsC)
(check-apply poly-inputT full-args)))
(test "Polymorphic partial application propagates found type-vars."
- (|> (@common.with-unknown-type
- (@.analyse-apply analyse polyT (' [])
- (list.take (n/inc var-idx) inputsC)))
+ (|> (@.analyse-apply analyse polyT (' []) (list.take (n/inc var-idx) inputsC))
(check-apply partial-polyT1 (n/inc var-idx))))
(test "Polymorphic partial application preserves quantification for type-vars."
- (|> (@common.with-unknown-type
- (@.analyse-apply analyse polyT (' [])
- (list.take var-idx inputsC)))
+ (|> (@.analyse-apply analyse polyT (' []) (list.take var-idx inputsC))
(check-apply partial-polyT2 var-idx)))
))))
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
index bde0e0b60..9701a04b6 100644
--- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
@@ -254,61 +254,34 @@
sizeC (|> r.nat (:: @ map code.nat))
idxC (|> r.nat (:: @ map code.nat))
var-name (r.text +5)
- #let [arrayT (type (Array elemT))]]
+ #let [arrayT (type (Array elemT))
+ g!array (code.local-symbol var-name)
+ array-operation (function [output-type code]
+ (|> (&scope.with-scope ""
+ (&scope.with-local [var-name arrayT]
+ (&.with-type output-type
+ (analyse code))))
+ (macro.run (init-compiler []))
+ (case> (#e.Success _)
+ true
+
+ (#e.Error error)
+ false)))]]
($_ seq
(test "Can create arrays."
(check-success+ "lux array new" (list sizeC) arrayT))
(test "Can get a value inside an array."
- (|> (&scope.with-scope ""
- (&scope.with-local [var-name arrayT]
- (&.with-type elemT
- (analyse (` ("lux array get"
- (~ (code.symbol ["" var-name]))
- (~ idxC)))))))
- (macro.run (init-compiler []))
- (case> (#e.Success _)
- true
-
- (#e.Error _)
- false)))
+ (array-operation (type (Maybe elemT))
+ (` ("lux array get" (~ g!array) (~ idxC)))))
(test "Can put a value inside an array."
- (|> (&scope.with-scope ""
- (&scope.with-local [var-name arrayT]
- (&.with-type arrayT
- (analyse (` ("lux array put"
- (~ (code.symbol ["" var-name]))
- (~ idxC)
- (~ elemC)))))))
- (macro.run (init-compiler []))
- (case> (#e.Success _)
- true
-
- (#e.Error _)
- false)))
+ (array-operation arrayT
+ (` ("lux array put" (~ g!array) (~ idxC) (~ elemC)))))
(test "Can remove a value from an array."
- (|> (&scope.with-scope ""
- (&scope.with-local [var-name arrayT]
- (&.with-type arrayT
- (analyse (` ("lux array remove"
- (~ (code.symbol ["" var-name]))
- (~ idxC)))))))
- (macro.run (init-compiler []))
- (case> (#e.Success _)
- true
-
- (#e.Error _)
- false)))
+ (array-operation arrayT
+ (` ("lux array remove" (~ g!array) (~ idxC)))))
(test "Can query the size of an array."
- (|> (&scope.with-scope ""
- (&scope.with-local [var-name arrayT]
- (&.with-type Nat
- (analyse (` ("lux array size" (~ (code.symbol ["" var-name]))))))))
- (macro.run (init-compiler []))
- (case> (#e.Success _)
- true
-
- (#e.Error _)
- false)))
+ (array-operation Nat
+ (` ("lux array size" (~ g!array)))))
))))
(context: "Math procedures"
diff --git a/new-luxc/test/test/luxc/lang/analysis/structure.lux b/new-luxc/test/test/luxc/lang/analysis/structure.lux
index 5694c0927..42177ebb4 100644
--- a/new-luxc/test/test/luxc/lang/analysis/structure.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/structure.lux
@@ -185,15 +185,15 @@
true)))
))))
-(def: (check-variant-inference variantT choice size analysis)
- (-> Type Nat Nat (Meta [Module Scope Type la.Analysis]) Bool)
+(def: (check-variant variantT choice size analysis)
+ (-> Type Nat Nat (Meta [Module Scope la.Analysis]) Bool)
(|> analysis
+ (&.with-type variantT)
(macro.run (init-compiler []))
- (case> (^multi (#e.Success [_ _ sumT sumA])
+ (case> (^multi (#e.Success [_ _ sumA])
[(la.unfold-variant sumA)
(#.Some [tag last? valueA])])
- (and (type/= variantT sumT)
- (n/= tag choice)
+ (and (n/= tag choice)
(bool/= last? (n/= (n/dec size) choice)))
_
@@ -241,25 +241,22 @@
(do macro.Monad
[_ (@module.declare-tags tags false namedT)]
(&.with-scope
- (@common.with-unknown-type
- (@.analyse-tagged-sum analyse [module-name choice-tag] choiceC)))))
- (check-variant-inference variantT choice size)))
+ (@.analyse-tagged-sum analyse [module-name choice-tag] choiceC))))
+ (check-variant variantT choice size)))
(test "Tagged sums specialize when type-vars get bound."
(|> (@module.with-module +0 module-name
(do macro.Monad
[_ (@module.declare-tags tags false named-polyT)]
(&.with-scope
- (@common.with-unknown-type
- (@.analyse-tagged-sum analyse [module-name choice-tag] choiceC)))))
- (check-variant-inference variantT choice size)))
+ (@.analyse-tagged-sum analyse [module-name choice-tag] choiceC))))
+ (check-variant variantT choice size)))
(test "Tagged sum inference retains universal quantification when type-vars are not bound."
(|> (@module.with-module +0 module-name
(do macro.Monad
[_ (@module.declare-tags tags false named-polyT)]
(&.with-scope
- (@common.with-unknown-type
- (@.analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC)))))
- (check-variant-inference polyT other-choice size)))
+ (@.analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))
+ (check-variant polyT other-choice size)))
(test "Can specialize generic tagged sums."
(|> (@module.with-module +0 module-name
(do macro.Monad
diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/case.lux b/new-luxc/test/test/luxc/lang/translation/jvm/case.lux
index 91071be6c..2df52d78b 100644
--- a/new-luxc/test/test/luxc/lang/translation/jvm/case.lux
+++ b/new-luxc/test/test/luxc/lang/translation/jvm/case.lux
@@ -48,24 +48,27 @@
#let [caseS (` [(~+ (list.concat (list (list.repeat idx (' []))
(list subS)
(list.repeat (|> size n/dec (n/- idx)) (' [])))))])
- caseP (if (tail? size idx)
- (` ("lux case tuple right" (~ (code.nat idx)) (~ subP)))
- (` ("lux case tuple left" (~ (code.nat idx)) (~ subP))))]]
+ caseP (` ("lux case seq"
+ (~ (if (tail? size idx)
+ (` ("lux case tuple right" (~ (code.nat idx))))
+ (` ("lux case tuple left" (~ (code.nat idx))))))
+ (~ subP)))]]
(wrap [caseS caseP]))
(do r.Monad
[size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2))))
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] gen-case
#let [caseS (` ((~ (code.nat idx)) (~ (code.bool (tail? size idx))) (~ subS)))
- caseP (if (tail? size idx)
- (` ("lux case variant right" (~ (code.nat idx)) (~ subP)))
- (` ("lux case variant left" (~ (code.nat idx)) (~ subP))))]]
+ caseP (` ("lux case seq"
+ (~ (if (tail? size idx)
+ (` ("lux case variant right" (~ (code.nat idx))))
+ (` ("lux case variant left" (~ (code.nat idx))))))
+ (~ subP)))]]
(wrap [caseS caseP]))
))))
(context: "Pattern-matching."
- (<| (seed +517905247826)
- ## (times +100)
+ (<| (times +100)
(do @
[[valueS pathS] gen-case
to-bind r.nat]
--
cgit v1.2.3