www

commit d58c8b028110700670006f55d55c7eb98e92919d
parent 0a15ae4bb618b50a2f5f2fe4792181a0d24e9e97
Author: Stephen Chang <stchang@ccs.neu.edu>
Date:   Tue,  5 Aug 2014 14:46:59 -0400

add null?

Diffstat:
M
stlc-tests.rkt
 | 
10
++++++++--
M
stlc.rkt
 | 
25
++++++++++++++++++-------

2 files changed, 26 insertions(+), 9 deletions(-)
diff --git a/stlc-tests.rkt b/stlc-tests.rkt
@@ -29,4 +29,11 @@
 (check-type-error (cons {String} 1 (null {Int})))
 (check-type-error (cons {String} "one" (cons {Int} "two" (null {String}))))
 (check-type-and-result (first {String} (cons {String} "one" (cons {String} "two" (null {String}))))
-                       : String => "one")
-\ No newline at end of file
+                       : String => "one")
+(check-type-and-result (null? {String} (null {String})) : Bool => #t)
+(check-type-and-result (null? {String} (cons {String} "one" (null {String}))) : Bool => #f)
+(check-type-error (null? {String} (null {Int})))
+(check-type-error (null? {Int} (null {String})))
+(check-type-error (null? {Int} 1))
+(check-type-error (null? {Int} "one"))
+(check-type-error (null? {Int} (cons {String} "one" (null {String}))))
diff --git a/stlc.rkt b/stlc.rkt
@@ -3,12 +3,16 @@
   (for-syntax syntax/parse syntax/id-table syntax/stx racket/list
               "stx-utils.rkt")
   (for-meta 2 racket/base syntax/parse))
-(provide (except-out (all-from-out racket) 
-                     λ #%app + #%datum let cons null first rest))
+(provide 
+ (except-out
+  (all-from-out racket) 
+  λ #%app + #%datum let cons null null? first rest))
 
-(provide (rename-out [λ/tc λ] [app/tc #%app] [let/tc let] 
-                     [+/tc +] [datum/tc #%datum] 
-                     [cons/tc cons] [null/tc null] [first/tc first] [rest/tc rest]))
+(provide 
+ (rename-out
+  [λ/tc λ] [app/tc #%app] [let/tc let] 
+  [+/tc +] [datum/tc #%datum] 
+  [cons/tc cons] [null/tc null] [null?/tc null?] [first/tc first] [rest/tc rest]))
 
 (provide Int String Bool → Listof)
 (define Int #f)
@@ -99,8 +103,9 @@
 ;; typed forms ----------------------------------------------------------------
 (define-syntax (datum/tc stx)
   (syntax-parse stx
-    [(_ . x:integer) (⊢ (syntax/loc stx (#%datum . x)) #'Int)]
-    [(_ . x:str) (⊢ (syntax/loc stx (#%datum . x)) #'String)]
+    [(_ . n:integer) (⊢ (syntax/loc stx (#%datum . n)) #'Int)]
+    [(_ . s:str) (⊢ (syntax/loc stx (#%datum . s)) #'String)]
+    [(_ . b:boolean) (⊢ (syntax/loc stx (#%datum . b)) #'Bool)]
     [(_ . x) 
      #:when (error 'TYPE-ERROR "~a (~a:~a) has unknown type" 
                    #'x (syntax-line #'x) (syntax-column #'x))
@@ -154,6 +159,12 @@
 (define-syntax (null/tc stx)
   (syntax-parse stx
     [(_ {T}) (⊢ (syntax/loc stx null) #'(Listof T))]))
+(define-syntax (null?/tc stx)
+  (syntax-parse stx
+    [(_ {T} e)
+     #:with e+ (expand/df #'e)
+     #:when (assert-type #'e+ #'(Listof T))
+     (⊢ (syntax/loc stx (null? e+)) #'Bool)]))
 (define-syntax (first/tc stx)
   (syntax-parse stx
     [(_ {T} e)