www

commit 48b625c2f429a5be41fe3a124e7532752eab0de5
parent 4dd2b66d2b1bfd2e024703f5607b4795a98f31e1
Author: Stephen Chang <stchang@ccs.neu.edu>
Date:   Wed, 14 Oct 2015 15:39:11 -0400

define star as rename-transformer to #%type, in fomega

Diffstat:
M
tapl/fomega.rkt
 | 
22
+++++++++++++---------
M
tapl/tests/fomega-tests.rkt
 | 
2
+-

2 files changed, 14 insertions(+), 10 deletions(-)
diff --git a/tapl/fomega.rkt b/tapl/fomega.rkt
@@ -14,6 +14,10 @@
 
 (define-syntax-category kind)
 
+; want #%type to be equiv to★
+; => edit current-kind? so existing #%type annotations (with no #%kind tag)
+;    are treated as kinds
+; <= define ★ as rename-transformer expanding to #%type
 (begin-for-syntax
   (current-kind? (λ (k) (or (#%type? k) (kind? k))))
   ;; Try to keep "type?" backward compatible with its uses so far,
@@ -35,8 +39,9 @@
      #:fail-unless ((current-kind?) #'k_τ) (format "not a valid type: ~a\n" (type->str #'τ))
      #'(define-syntax alias (syntax-parser [x:id #'τ-][(_ . rst) #'(τ- . rst)]))]))
 
-
-(define-base-kind ★)
+(provide ★ (for-syntax ★?))
+(define-for-syntax ★? #%type?)
+(define-syntax ★ (make-rename-transformer #'#%type))
 (define-kind-constructor ⇒ #:arity >= 1)
 (define-kind-constructor ∀★ #:arity >= 0)
 
@@ -66,13 +71,12 @@
   (current-type-eval type-eval)
   
   (define old-type=? (current-type=?))
+  ; ty=? == syntax eq and syntax prop eq
   (define (type=? t1 t2)
-    (or (and (★? t1) (#%type? t2))
-        (and (#%type? t1) (★? t2))
-        (let ([k1 (typeof t1)][k2 (typeof t2)])
-          (and (or (and (not k1) (not k2))
-                   (and k1 k2 ((current-type=?) k1 k2)))
-               (old-type=? t1 t2)))))
+    (let ([k1 (typeof t1)][k2 (typeof t2)])
+      (and (or (and (not k1) (not k2))
+               (and k1 k2 ((current-type=?) k1 k2)))
+           (old-type=? t1 t2))))
   (current-type=? type=?)
   (current-typecheck-relation (current-type=?)))
 
@@ -98,7 +102,7 @@
   [(_ bvs:kind-ctx τ_body)
    #:with (tvs- τ_body- k_body) (infer/ctx+erase #'bvs #'τ_body)
    #:fail-unless ((current-kind?) #'k_body)
-                 (format "not a valid kind: ~a\n" (type->str #'k_body))
+                 (format "not a valid type: ~a\n" (type->str #'τ_body))
    (⊢ (λ tvs- τ_body-) : (⇒ bvs.kind ... k_body))])
 
 (define-typed-syntax tyapp
diff --git a/tapl/tests/fomega-tests.rkt b/tapl/tests/fomega-tests.rkt
@@ -9,7 +9,7 @@
 (typecheck-fail (→ 1))
 (check-type 1 : Int)
 
-(typecheck-fail (tyλ ([x : ★]) 1) #:with-msg "not a valid kind: Int")
+(typecheck-fail (tyλ ([x : ★]) 1) #:with-msg "not a valid type: 1")
 
 (check-type (Λ ([X : ★]) (λ ([x : X]) x)) : (∀ ([X : ★]) (→ X X)))
 (check-not-type (Λ ([X : ★]) (λ ([x : X]) x)) :