www

commit fba974d8bb7c960733d40501f08b4af32e0c1d07
parent 9ea6c6b51338052f598765407185f3236100e4ec
Author: AlexKnauth <alexander@knauth.org>
Date:   Wed, 22 Jun 2016 12:06:43 -0400

start converting mlish tests to typed-lang-builder/mlish-core

Diffstat:
M
tapl/tests/mlish/listpats.mlish
 | 
2
+-
M
tapl/tests/mlish/loop.mlish
 | 
2
+-
M
tapl/tests/mlish/match2.mlish
 | 
8
++++----
M
tapl/tests/mlish/polyrecur.mlish
 | 
2
+-
M
tapl/tests/mlish/queens.mlish
 | 
2
+-
M
tapl/tests/mlish/value-restriction-example.mlish
 | 
2
+-
M
tapl/typed-lang-builder/mlish-core.rkt
 | 
1
+

7 files changed, 10 insertions(+), 9 deletions(-)
diff --git a/tapl/tests/mlish/listpats.mlish b/tapl/tests/mlish/listpats.mlish
@@ -1,4 +1,4 @@
-#lang s-exp "../../mlish.rkt"
+#lang s-exp "../../typed-lang-builder/mlish-core.rkt"
 (require "../rackunit-typechecking.rkt")
 
 ;; pattern matching for built-in lists
diff --git a/tapl/tests/mlish/loop.mlish b/tapl/tests/mlish/loop.mlish
@@ -1,4 +1,4 @@
-#lang s-exp "../../mlish.rkt"
+#lang s-exp "../../typed-lang-builder/mlish-core.rkt"
 (require "../rackunit-typechecking.rkt")
 
 ;; datatype with no self-reference
diff --git a/tapl/tests/mlish/match2.mlish b/tapl/tests/mlish/match2.mlish
@@ -1,4 +1,4 @@
-#lang s-exp "../../mlish.rkt"
+#lang s-exp "../../typed-lang-builder/mlish-core.rkt"
 (require "../rackunit-typechecking.rkt")
 
 ;; alternate match that supports nested patterns
@@ -17,14 +17,14 @@
   (match2 (B (tup 2 3)) with
    [A x -> x]
    [C (x,y) -> y]
-   [B x -> x]) #:with-msg "branches have incompatible types: \\(× Int Int\\) and Int")
+   [B x -> x]) #:with-msg "branches have incompatible types: Int and \\(× Int Int\\)")
 
 (typecheck-fail
   (match2 (B (tup 2 3)) with
    [A x -> (tup x x)]
    [C x -> x]
    [B x -> x])
-  #:with-msg "branches have incompatible types: \\(× Int \\(× Int Int\\)\\) and \\(× Int Int\\)")
+  #:with-msg "branches have incompatible types: \\(× Int Int\\) and \\(× Int \\(× Int Int\\)\\)")
 
 (check-type
   (match2 (B (tup 2 3)) with
@@ -241,7 +241,7 @@
     (match2 (list (list #t #f)) with
       [nil -> -1]
       [(list x y) :: tl -> (+ x y)])
-  #:with-msg "Type error applying function \\+")
+  #:with-msg "expected: Int\n *given: Bool")
 
 ;; comma tup pattern syntax
 
diff --git a/tapl/tests/mlish/polyrecur.mlish b/tapl/tests/mlish/polyrecur.mlish
@@ -1,4 +1,4 @@
-#lang s-exp "../../mlish.rkt"
+#lang s-exp "../../typed-lang-builder/mlish-core.rkt"
 (require "../rackunit-typechecking.rkt")
 
 ;; tests of polymorphic recursion
diff --git a/tapl/tests/mlish/queens.mlish b/tapl/tests/mlish/queens.mlish
@@ -1,4 +1,4 @@
-#lang s-exp "../../mlish.rkt"
+#lang s-exp "../../typed-lang-builder/mlish-core.rkt"
 (require "../rackunit-typechecking.rkt")
 
 ;; function polymorphic in list element
diff --git a/tapl/tests/mlish/value-restriction-example.mlish b/tapl/tests/mlish/value-restriction-example.mlish
@@ -1,4 +1,4 @@
-#lang s-exp "../../mlish.rkt"
+#lang s-exp "../../typed-lang-builder/mlish-core.rkt"
 (require "../rackunit-typechecking.rkt")
 
 (define-type (Option X)
diff --git a/tapl/typed-lang-builder/mlish-core.rkt b/tapl/typed-lang-builder/mlish-core.rkt
@@ -756,6 +756,7 @@
   [(match e with . clauses) ▶
    [#:fail-unless (not (null? (syntax->list #'clauses))) "no clauses"]
    [⊢ [[e ≫ e-] ⇒ : τ_e]]
+   [#:when (and (not (×? #'τ_e)) (not (List? #'τ_e)))]
    [#:with t_expect (get-expected-type stx)] ; propagate inferred type
    [#:with ([Clause:id x:id ... 
                        (~optional (~seq #:when e_guard) #:defaults ([e_guard #'(ext-stlc:#%datum . #t)]))