7491e172ea
The eopl language is now racket-based rather than mzscheme-based. This test-suite, which was originally distributed on the book's web-site has been re-written in the new language. Changes include dropping all drscheme-init.scm and top.scm files. Remaining files were renamed to use the .rkt extension and edited to use the #lang syntax (instead of modulue). Require and provide forms were changed to reflect racket's syntax instead of mzscheme's (eg, only-in vs. only). Several occurrences of one-armed ifs were changed to use when and unless. All tests have been run successfully.
125 lines
4.4 KiB
Racket
Executable File
125 lines
4.4 KiB
Racket
Executable File
#lang eopl
|
|
|
|
(require "lang.rkt")
|
|
(require "static-data-structures.rkt")
|
|
(require "expand-type.rkt")
|
|
|
|
(provide type-of)
|
|
|
|
;; check-equal-type! : Type * Type * Exp -> Unspecified
|
|
;; Page: 242
|
|
(define check-equal-type!
|
|
(lambda (ty1 ty2 exp)
|
|
(unless (equal? ty1 ty2)
|
|
(report-unequal-types ty1 ty2 exp))))
|
|
|
|
;; report-unequal-types : Type * Type * Exp -> Unspecified
|
|
;; Page: 243
|
|
(define report-unequal-types
|
|
(lambda (ty1 ty2 exp)
|
|
(eopl:error 'check-equal-type!
|
|
"Types didn't match: ~s != ~a in~%~a"
|
|
(type-to-external-form ty1)
|
|
(type-to-external-form ty2)
|
|
exp)))
|
|
|
|
;;;;;;;;;;;;;;;; The Type Checker ;;;;;;;;;;;;;;;;
|
|
|
|
;; moved to check-modules.scm
|
|
;; type-of-program : Program -> Type
|
|
;; Page: 244
|
|
;; (define type-of-program
|
|
;; (lambda (pgm)
|
|
;; (cases program pgm
|
|
;; (a-program (exp1)
|
|
;; (type-of exp1 (init-tenv))))))
|
|
|
|
|
|
;; type-of : Exp * Tenv -> Type
|
|
;; Page 244--246. See also page 285.
|
|
(define type-of
|
|
(lambda (exp tenv)
|
|
(cases expression exp
|
|
(const-exp (num) (int-type))
|
|
|
|
(diff-exp (exp1 exp2)
|
|
(let ((type1 (type-of exp1 tenv))
|
|
(type2 (type-of exp2 tenv)))
|
|
(check-equal-type! type1 (int-type) exp1)
|
|
(check-equal-type! type2 (int-type) exp2)
|
|
(int-type)))
|
|
|
|
(zero?-exp (exp1)
|
|
(let ((type1 (type-of exp1 tenv)))
|
|
(check-equal-type! type1 (int-type) exp1)
|
|
(bool-type)))
|
|
|
|
(if-exp (exp1 exp2 exp3)
|
|
(let ((ty1 (type-of exp1 tenv))
|
|
(ty2 (type-of exp2 tenv))
|
|
(ty3 (type-of exp3 tenv)))
|
|
(check-equal-type! ty1 (bool-type) exp1)
|
|
(check-equal-type! ty2 ty3 exp)
|
|
ty2))
|
|
|
|
(var-exp (var) (apply-tenv tenv var))
|
|
|
|
;; lookup-qualified-var-in-tenv defined on page 285.
|
|
(qualified-var-exp (m-name var-name)
|
|
(lookup-qualified-var-in-tenv m-name var-name tenv))
|
|
|
|
(let-exp (var exp1 body)
|
|
(let ((rhs-type (type-of exp1 tenv)))
|
|
(type-of body (extend-tenv var rhs-type tenv))))
|
|
|
|
(proc-exp (bvar bvar-type body)
|
|
(let ((expanded-bvar-type
|
|
(expand-type bvar-type tenv)))
|
|
(let ((result-type
|
|
(type-of body
|
|
(extend-tenv
|
|
bvar
|
|
expanded-bvar-type
|
|
tenv))))
|
|
(proc-type expanded-bvar-type result-type))))
|
|
|
|
(call-exp (rator rand)
|
|
(let ((rator-type (type-of rator tenv))
|
|
(rand-type (type-of rand tenv)))
|
|
(cases type rator-type
|
|
(proc-type (arg-type result-type)
|
|
(begin
|
|
(check-equal-type! arg-type rand-type rand)
|
|
result-type))
|
|
(else
|
|
(eopl:error 'type-of
|
|
"Rator not a proc type:~%~s~%had rator type ~s"
|
|
rator (type-to-external-form rator-type))))))
|
|
|
|
(letrec-exp (proc-result-type proc-name
|
|
bvar bvar-type
|
|
proc-body
|
|
letrec-body)
|
|
(let ((tenv-for-letrec-body
|
|
(extend-tenv
|
|
proc-name
|
|
(expand-type
|
|
(proc-type bvar-type proc-result-type)
|
|
tenv)
|
|
tenv)))
|
|
(let ((proc-result-type
|
|
(expand-type proc-result-type tenv))
|
|
(proc-body-type
|
|
(type-of proc-body
|
|
(extend-tenv
|
|
bvar
|
|
(expand-type bvar-type tenv)
|
|
tenv-for-letrec-body))))
|
|
(check-equal-type!
|
|
proc-body-type proc-result-type proc-body)
|
|
(type-of letrec-body tenv-for-letrec-body))))
|
|
|
|
)))
|
|
|
|
;; type environments are now in static-data-structures.rkt .
|