90 lines
2.0 KiB
Scheme
Executable File
90 lines
2.0 KiB
Scheme
Executable File
(module data-structures (lib "eopl.ss" "eopl")
|
|
|
|
;; data structures for proc-lang/proc-rep
|
|
|
|
(require "lang.scm") ; for expression?
|
|
|
|
(provide (all-defined)) ; too many things to list
|
|
|
|
;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
|
|
|
|
;;; an expressed value is either a number, a boolean or a procval.
|
|
|
|
(define-datatype expval expval?
|
|
(num-val
|
|
(value number?))
|
|
(bool-val
|
|
(boolean boolean?))
|
|
(proc-val
|
|
(proc proc?)))
|
|
|
|
;;; extractors:
|
|
|
|
;; expval->num : ExpVal -> Int
|
|
(define expval->num
|
|
(lambda (v)
|
|
(cases expval v
|
|
(num-val (num) num)
|
|
(else (expval-extractor-error 'num v)))))
|
|
|
|
;; expval->bool : ExpVal -> Bool
|
|
(define expval->bool
|
|
(lambda (v)
|
|
(cases expval v
|
|
(bool-val (bool) bool)
|
|
(else (expval-extractor-error 'bool v)))))
|
|
|
|
;; expval->proc : ExpVal -> Proc
|
|
(define expval->proc
|
|
(lambda (v)
|
|
(cases expval v
|
|
(proc-val (proc) proc)
|
|
(else (expval-extractor-error 'proc v)))))
|
|
|
|
(define expval-extractor-error
|
|
(lambda (variant value)
|
|
(eopl:error 'expval-extractors "Looking for a ~s, found ~s"
|
|
variant value)))
|
|
|
|
;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
|
|
|
|
;; proc? : SchemeVal -> Bool
|
|
;; Page: 79
|
|
(define proc? procedure?)
|
|
|
|
;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
|
|
|
|
;; example of a data type built without define-datatype
|
|
|
|
(define empty-env-record
|
|
(lambda ()
|
|
'()))
|
|
|
|
(define extended-env-record
|
|
(lambda (sym val old-env)
|
|
(cons (list sym val) old-env)))
|
|
|
|
(define empty-env-record? null?)
|
|
|
|
(define environment?
|
|
(lambda (x)
|
|
(or (empty-env-record? x)
|
|
(and (pair? x)
|
|
(symbol? (car (car x)))
|
|
(expval? (cadr (car x)))
|
|
(environment? (cdr x))))))
|
|
|
|
(define extended-env-record->sym
|
|
(lambda (r)
|
|
(car (car r))))
|
|
|
|
(define extended-env-record->val
|
|
(lambda (r)
|
|
(cadr (car r))))
|
|
|
|
(define extended-env-record->old-env
|
|
(lambda (r)
|
|
(cdr r)))
|
|
|
|
)
|