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.
116 lines
3.1 KiB
Racket
Executable File
116 lines
3.1 KiB
Racket
Executable File
#lang eopl
|
|
|
|
(require "lang.rkt") ; for expression?
|
|
(require "store.rkt") ; for reference?
|
|
(require "classes.rkt") ; for object?
|
|
|
|
(provide (all-defined-out)) ; too many things to list
|
|
|
|
;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
|
|
|
|
;;; an expressed value is either a number, a boolean, a procval, or a
|
|
;;; reference.
|
|
|
|
(define-datatype expval expval?
|
|
(num-val
|
|
(value number?))
|
|
(bool-val
|
|
(boolean boolean?))
|
|
(proc-val
|
|
(proc proc?))
|
|
(ref-val
|
|
(ref reference?))
|
|
(obj-val
|
|
(obj object?))
|
|
(list-val
|
|
(lst (list-of expval?)))
|
|
)
|
|
|
|
;;; extractors:
|
|
|
|
(define expval->num
|
|
(lambda (v)
|
|
(cases expval v
|
|
(num-val (num) num)
|
|
(else (expval-extractor-error 'num v)))))
|
|
|
|
(define expval->bool
|
|
(lambda (v)
|
|
(cases expval v
|
|
(bool-val (bool) bool)
|
|
(else (expval-extractor-error 'bool v)))))
|
|
|
|
(define expval->proc
|
|
(lambda (v)
|
|
(cases expval v
|
|
(proc-val (proc) proc)
|
|
(else (expval-extractor-error 'proc v)))))
|
|
|
|
;; not used. Nor is expval->obj or expval->list, so we haven't
|
|
;; written them.
|
|
(define expval->ref
|
|
(lambda (v)
|
|
(cases expval v
|
|
(ref-val (ref) ref)
|
|
(else (expval-extractor-error 'reference v)))))
|
|
|
|
(define expval-extractor-error
|
|
(lambda (variant value)
|
|
(eopl:error 'expval-extractors "Looking for a ~s, found ~s"
|
|
variant value)))
|
|
|
|
;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
|
|
|
|
(define-datatype proc proc?
|
|
(procedure
|
|
(vars (list-of symbol?))
|
|
(body expression?)
|
|
(env environment?)))
|
|
|
|
(define-datatype environment environment?
|
|
(empty-env)
|
|
(extend-env
|
|
(bvars (list-of symbol?))
|
|
(bvals (list-of reference?))
|
|
(saved-env environment?))
|
|
(extend-env-rec**
|
|
(proc-names (list-of symbol?))
|
|
(b-varss (list-of (list-of symbol?)))
|
|
(proc-bodies (list-of expression?))
|
|
(saved-env environment?))
|
|
(extend-env-with-self-and-super
|
|
(self object?)
|
|
(super-name symbol?)
|
|
(saved-env environment?)))
|
|
|
|
;; env->list : Env -> List
|
|
;; used for pretty-printing and debugging
|
|
(define env->list
|
|
(lambda (env)
|
|
(cases environment env
|
|
(empty-env () '())
|
|
(extend-env (sym val saved-env)
|
|
(cons
|
|
(list sym val)
|
|
(env->list saved-env)))
|
|
(extend-env-rec** (p-names b-varss p-bodies saved-env)
|
|
(cons
|
|
(list 'letrec p-names '...)
|
|
(env->list saved-env)))
|
|
(extend-env-with-self-and-super (self super-name saved-env)
|
|
(cons
|
|
(list 'self self 'super super-name)
|
|
(env->list saved-env))))))
|
|
|
|
;; expval->printable : ExpVal -> List
|
|
;; returns a value like its argument, except procedures get cleaned
|
|
;; up with env->list
|
|
(define expval->printable
|
|
(lambda (val)
|
|
(cases expval val
|
|
(proc-val (p)
|
|
(cases proc p
|
|
(procedure (var body saved-env)
|
|
(list 'procedure var '... (env->list saved-env)))))
|
|
(else val))))
|