- Fixed the remaining broken tests in new-luxc.

4 files changed, 65 insertions, 105 deletions

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<Meta>
                           [_ (@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<Meta>
                           [_ (@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<Meta>
                           [_ (@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<Meta>
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<Random>
                 [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]