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.
78 lines
2.7 KiB
Racket
Executable File
78 lines
2.7 KiB
Racket
Executable File
#lang eopl
|
|
|
|
(require "lang.rkt")
|
|
(require "static-data-structures.rkt")
|
|
(require "checker.rkt")
|
|
(require "subtyping.rkt")
|
|
|
|
(require (only-in racket pretty-print))
|
|
|
|
(provide type-of-program)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; type-of-program : Program -> Type
|
|
;; Page: 286
|
|
(define type-of-program
|
|
(lambda (pgm)
|
|
(cases program pgm
|
|
(a-program (module-defs body)
|
|
(type-of body
|
|
(add-module-defns-to-tenv module-defs (empty-tenv)))))))
|
|
|
|
;; add-module-defns-to-tenv : Listof(ModuleDefn) * Tenv -> Tenv
|
|
;; Page: 286
|
|
(define add-module-defns-to-tenv
|
|
(lambda (defns tenv)
|
|
(if (null? defns)
|
|
tenv
|
|
(cases module-definition (car defns)
|
|
(a-module-definition (m-name expected-iface m-body)
|
|
(let ((actual-iface (interface-of m-body tenv)))
|
|
(if (<:-iface actual-iface expected-iface tenv)
|
|
(let ((new-tenv
|
|
(extend-tenv-with-module
|
|
m-name
|
|
expected-iface
|
|
tenv)))
|
|
(add-module-defns-to-tenv
|
|
(cdr defns) new-tenv))
|
|
(report-module-doesnt-satisfy-iface
|
|
m-name expected-iface actual-iface))))))))
|
|
|
|
;; interface-of : ModuleBody * Tenv -> Iface
|
|
;; Page: 288
|
|
(define interface-of
|
|
(lambda (m-body tenv)
|
|
(cases module-body m-body
|
|
(defns-module-body (defns)
|
|
(simple-iface
|
|
(defns-to-decls defns tenv))) )))
|
|
|
|
;; defns-to-decls : Listof(Defn) * Tenv -> Listof(Decl)
|
|
;; Page: 288
|
|
;;
|
|
;; Convert defns to a set of declarations for just the names defined
|
|
;; in defns. Do this in the context of tenv. The tenv is extended
|
|
;; at every step, so we get the correct let* scoping
|
|
;;
|
|
(define defns-to-decls
|
|
(lambda (defns tenv)
|
|
(if (null? defns)
|
|
'()
|
|
(cases definition (car defns)
|
|
(val-defn (var-name exp)
|
|
(let ((ty (type-of exp tenv)))
|
|
(let ((new-env (extend-tenv var-name ty tenv)))
|
|
(cons
|
|
(val-decl var-name ty)
|
|
(defns-to-decls (cdr defns) new-env)))))))))
|
|
|
|
(define report-module-doesnt-satisfy-iface
|
|
(lambda (m-name expected-type actual-type)
|
|
(pretty-print
|
|
(list 'error-in-defn-of-module: m-name
|
|
'expected-type: expected-type
|
|
'actual-type: actual-type))
|
|
(eopl:error 'type-of-module-defn)))
|