commit fbca467d01dc47ec53c73a3e31689243b673a22f
parent 70767635bb8cccfcba4432bc746a33e0964db805
Author: Stephen Chang <stchang@ccs.neu.edu>
Date: Tue, 19 Aug 2014 16:05:08 -0400
typecheck: add type-error form
Diffstat:
2 files changed, 26 insertions(+), 6 deletions(-)
diff --git a/stlc.rkt b/stlc.rkt
@@ -76,9 +76,10 @@
[(_ . 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))
+ [(_ x)
+ #:when (type-error #:src #'x #:msg "~a has unknown type" #'x)
+ #;(error 'TYPE-ERROR "~a (~a:~a) has unknown type"
+ #'x (syntax-line #'x) (syntax-column #'x))
(syntax/loc stx (#%datum . x))]))
(define-syntax (begin/tc stx)
@@ -166,7 +167,11 @@
#:with e1+ (expand/df #'e1)
#:with e2+ (expand/df #'e2)
#:when (or (type=? (typeof #'e1+) (typeof #'e2+))
- (error 'TYPE-ERROR
+ (type-error #:src stx
+ #:msg "IF branches have differing types: branch ~a has type ~a and branch ~a has type ~a"
+ #'e1 (typeof #'e1+)
+ #'e2 (typeof #'e2+))
+ #;(error 'TYPE-ERROR
"(~a:~a) if branches have differing types: ~a has type ~a and ~a has type ~a"
(syntax-line stx) (syntax-column stx)
(syntax->datum #'e1) (typeof #'e1+)
diff --git a/typecheck.rkt b/typecheck.rkt
@@ -6,6 +6,16 @@
(provide (all-defined-out)
(for-syntax (all-defined-out)))
+(begin-for-syntax
+ ;; usage:
+ ;; type-error #:src src-stx
+ ;; #:msg msg-string msg-args ...
+ ;; msg-args should be syntax
+ (define-syntax-rule (type-error #:src stx-src #:msg msg args ...)
+ (error 'TYPE-ERROR
+ (string-append "(~a:~a) " msg)
+ (syntax-line stx-src) (syntax-column stx-src) (syntax->datum args) ...)))
+
;; for types, just need the identifier bound
(define-syntax-rule (define-and-provide-builtin-type τ)
(begin (define τ #f) (provide τ)))
@@ -28,7 +38,9 @@
(define-for-syntax (assert-type e τ)
; (printf "~a has type ~a; expected: ~a\n" (syntax->datum e) (syntax->datum (typeof e)) (syntax->datum τ))
(or (type=? (typeof e) τ)
- (error 'TYPE-ERROR "~a (~a:~a) has type ~a, but should have type ~a"
+ (type-error #:src e
+ #:msg "~a has type ~a, but should have type ~a" e (typeof e) τ)
+ #;(error 'TYPE-ERROR "~a (~a:~a) has type ~a, but should have type ~a"
(syntax->datum e)
(syntax-line e) (syntax-column e)
(syntax->datum (typeof e))
@@ -53,7 +65,10 @@
(define (type-env-lookup x)
(hash-ref (Γ) (syntax->datum x)
- (λ () (error 'TYPE-ERROR "Could not find type for variable ~a." (syntax->datum x)))))
+ (λ ()
+ (type-error #:src x
+ #:msg "Could not find type for variable ~a" x)
+ #;(error 'TYPE-ERROR "Could not find type for variable ~a." (syntax->datum x)))))
;; returns a new hash table extended with type associations x:τs
(define (type-env-extend x:τs)
