www

commit 6f48690446305aa0667746984efed5e7f2fdacfc
parent 4a44e51b80aa7b79f0f28483778e512ec9c110dc
Author: Stephen Chang <stchang@ccs.neu.edu>
Date:   Fri, 18 Mar 2016 20:57:02 -0400

define-type-alias supports type constructors

Diffstat:
M
tapl/stlc+reco+var.rkt
 | 
6
+++++-
M
tapl/tests/mlish/alex.mlish
 | 
1
+
M
tapl/tests/mlish/inst.mlish
 | 
23
+++++++++++++++++++++++

3 files changed, 29 insertions(+), 1 deletion(-)
diff --git a/tapl/stlc+reco+var.rkt b/tapl/stlc+reco+var.rkt
@@ -21,7 +21,11 @@
 (define-syntax define-type-alias
   (syntax-parser
     [(_ alias:id τ:type)
-     #'(define-syntax alias (make-variable-like-transformer #'τ.norm) #;(syntax-parser [x:id #'τ.norm]))]))
+     #'(define-syntax alias (make-variable-like-transformer #'τ.norm) #;(syntax-parser [x:id #'τ.norm]))]
+    [(_ (f:id x:id ...) ty)
+     #'(define-syntax (f stx)
+         (syntax-parse stx
+           [(_ x ...) #'ty]))]))
 
 (define-typed-syntax define
   [(_ x:id e)
diff --git a/tapl/tests/mlish/alex.mlish b/tapl/tests/mlish/alex.mlish
@@ -13,3 +13,4 @@
   (let ([y (f x)]) x))
 
 (check-type try : (→/test X (→ X Y) X))
+
diff --git a/tapl/tests/mlish/inst.mlish b/tapl/tests/mlish/inst.mlish
@@ -38,3 +38,26 @@
         [else (ok 0)]))
 
 (check-type f/cond : (→/test Bool (Result Int String)))
+
+(define-type-alias (Read-Result A) (Result (× A (List Char)) String))
+
+(define (alias-test -> (Read-Result A))
+  (Error "asd"))
+
+(check-type alias-test : (→/test (Result (× A (List Char)) String)))
+(check-type alias-test : (→/test (Read-Result A)))
+
+(define (alias-test2 [in : A] -> (Read-Result A))
+  (ok (tup in nil)))
+(define (alias-test3 [in : A] -> (Read-Result A))
+  (ok (tup in (list #\a #\b #\c))))
+
+(check-type alias-test2 : (→/test A (Result (× A (List Char)) String)))
+(check-type alias-test2 : (→/test A (Read-Result A)))
+(check-type alias-test3 : (→/test A (Result (× A (List Char)) String)))
+(check-type alias-test3 : (→/test A (Read-Result A)))
+
+(check-type alias-test2 : (→/test B (Result (× B (List Char)) String)))
+(check-type alias-test2 : (→/test B (Read-Result B)))
+(check-type alias-test3 : (→/test B (Result (× B (List Char)) String)))
+(check-type alias-test3 : (→/test B (Read-Result B)))