www

commit 8a7d487e1446aa69ba96ab3cef6cc44da2c3cde6
parent c9c0970307e7cd40c5705e9a87930d13ec7d3c70
Author: Stephen Chang <stchang@ccs.neu.edu>
Date:   Wed, 12 Oct 2016 16:13:45 -0400

check if valid type when instantiating a type alias; fixed #5

Diffstat:
M
macrotypes/examples/ext-stlc.rkt
 | 
6
++++--
M
macrotypes/examples/tests/ext-stlc-tests.rkt
 | 
5
+++++
M
turnstile/examples/ext-stlc.rkt
 | 
15
+++++++++------
M
turnstile/examples/tests/ext-stlc-tests.rkt
 | 
5
+++++

4 files changed, 23 insertions(+), 8 deletions(-)
diff --git a/macrotypes/examples/ext-stlc.rkt b/macrotypes/examples/ext-stlc.rkt
@@ -39,7 +39,7 @@
 (define-primop typed- - (→ Int Int Int))
 (define-primop typed* * : (→ Int Int Int))
 
-;; Using τ.norm leads to a "not valid type" error when file is compiled
+;; τ.norm in 1st case causes "not valid type" error when file is compiled
 (define-syntax define-type-alias
   (syntax-parser
     [(_ alias:id τ:type)
@@ -48,7 +48,9 @@
     [(_ (f:id x:id ...) ty)
      #'(define-syntax- (f stx)
          (syntax-parse stx
-           [(_ x ...) #'ty]))]))
+           [(_ x ...)
+            #:with τ:type #'ty
+            #'τ.norm]))]))
 
 (define-typed-syntax define
   [(_ x:id e)
diff --git a/macrotypes/examples/tests/ext-stlc-tests.rkt b/macrotypes/examples/tests/ext-stlc-tests.rkt
@@ -1,6 +1,11 @@
 #lang s-exp "../ext-stlc.rkt"
 (require "rackunit-typechecking.rkt")
 
+;; tests for define-type-alias
+(define-type-alias (A X) (add1 X))
+
+(typecheck-fail (λ ([f : (A 1)]) f) #:with-msg "not a valid type")
+
 ;; tests for stlc extensions
 ;; new literals and base types
 (check-type "one" : String) ; literal now supported
diff --git a/turnstile/examples/ext-stlc.rkt b/turnstile/examples/ext-stlc.rkt
@@ -38,15 +38,18 @@
 (define-primop typed- - (→ Int Int Int))
 (define-primop typed* * : (→ Int Int Int))
 
-;; Using τ.norm leads to a "not valid type" error when file is compiled
+;; τ.norm in 1st case causes "not valid type" error when file is compiled
 (define-syntax define-type-alias
   (syntax-parser
-    [(define-type-alias alias:id τ:type)
-     #'(define-syntax alias (make-variable-like-transformer #'τ))]
-    [(define-type-alias (f:id x:id ...) ty)
-     #'(define-syntax (f stx)
+    [(_ alias:id τ:type)
+     #'(define-syntax- alias
+         (make-variable-like-transformer #'τ))]
+    [(_ (f:id x:id ...) ty)
+     #'(define-syntax- (f stx)
          (syntax-parse stx
-           [(_ x ...) #'ty]))]))
+           [(_ x ...)
+            #:with τ:type #'ty
+            #'τ.norm]))]))
 
 (define-typed-syntax define
   [(_ x:id : τ:type e:expr) ≫
diff --git a/turnstile/examples/tests/ext-stlc-tests.rkt b/turnstile/examples/tests/ext-stlc-tests.rkt
@@ -1,6 +1,11 @@
 #lang s-exp "../ext-stlc.rkt"
 (require "rackunit-typechecking.rkt")
 
+;; tests for define-type-alias
+(define-type-alias (A X) (add1 X))
+
+(typecheck-fail (λ ([f : (A 1)]) f) #:with-msg "not a valid type")
+
 ;; tests for stlc extensions
 ;; new literals and base types
 (check-type "one" : String) ; literal now supported