suzanne.soy/macrotypes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

typecheck: add type-error form

Browse Source
This commit is contained in:
Stephen Chang 2014-08-19 16:05:08 -04:00
parent 70767635bb
commit fbca467d01
2 changed files with 26 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
stlc.rkt
View File

@ -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+)

19
typecheck.rkt
View File

@ -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)