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.
107 lines
3.0 KiB
Racket
Executable File
107 lines
3.0 KiB
Racket
Executable File
#lang eopl
|
|
|
|
(provide initialize-store! reference? newref deref setref!
|
|
instrument-newref get-store-as-list)
|
|
|
|
(define instrument-newref (make-parameter #f))
|
|
|
|
;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
|
|
|
|
;;; world's dumbest model of the store: the store is a list and a
|
|
;;; reference is number which denotes a position in the list.
|
|
|
|
;; the-store: a Scheme variable containing the current state of the
|
|
;; store. Initially set to a dummy variable.
|
|
(define the-store 'uninitialized)
|
|
|
|
;; empty-store : () -> Sto
|
|
;; Page: 111
|
|
(define empty-store
|
|
(lambda () '()))
|
|
|
|
;; initialize-store! : () -> Sto
|
|
;; usage: (initialize-store!) sets the-store to the empty-store
|
|
;; Page 111
|
|
(define initialize-store!
|
|
(lambda ()
|
|
(set! the-store (empty-store))))
|
|
|
|
;; get-store : () -> Sto
|
|
;; Page: 111
|
|
;; This is obsolete. Replaced by get-store-as-list below
|
|
(define get-store
|
|
(lambda () the-store))
|
|
|
|
;; reference? : SchemeVal -> Bool
|
|
;; Page: 111
|
|
(define reference?
|
|
(lambda (v)
|
|
(integer? v)))
|
|
|
|
;; newref : ExpVal -> Ref
|
|
;; Page: 111
|
|
(define newref
|
|
(lambda (val)
|
|
(let ((next-ref (length the-store)))
|
|
(set! the-store
|
|
(append the-store (list val)))
|
|
(when (instrument-newref)
|
|
(eopl:printf
|
|
"newref: allocating location ~s with initial contents ~s~%"
|
|
next-ref val))
|
|
next-ref)))
|
|
|
|
;; deref : Ref -> ExpVal
|
|
;; Page 111
|
|
(define deref
|
|
(lambda (ref)
|
|
(list-ref the-store ref)))
|
|
|
|
;; setref! : Ref * ExpVal -> Unspecified
|
|
;; Page: 112
|
|
(define setref!
|
|
(lambda (ref val)
|
|
(set! the-store
|
|
(letrec
|
|
((setref-inner
|
|
;; returns a list like store1, except that position ref1
|
|
;; contains val.
|
|
(lambda (store1 ref1)
|
|
(cond
|
|
((null? store1)
|
|
(report-invalid-reference ref the-store))
|
|
((zero? ref1)
|
|
(cons val (cdr store1)))
|
|
(else
|
|
(cons
|
|
(car store1)
|
|
(setref-inner
|
|
(cdr store1) (- ref1 1))))))))
|
|
(setref-inner the-store ref)))))
|
|
|
|
(define report-invalid-reference
|
|
(lambda (ref the-store)
|
|
(eopl:error 'setref
|
|
"illegal reference ~s in store ~s"
|
|
ref the-store)))
|
|
|
|
;; get-store-as-list : () -> Listof(List(Ref,Expval))
|
|
;; Exports the current state of the store as a scheme list.
|
|
;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
|
|
;; where foo, bar, and baz are expvals.
|
|
;; If the store were represented in a different way, this would be
|
|
;; replaced by something cleverer.
|
|
;; Replaces get-store (p. 111)
|
|
(define get-store-as-list
|
|
(lambda ()
|
|
(letrec
|
|
((inner-loop
|
|
;; convert sto to list as if its car was location n
|
|
(lambda (sto n)
|
|
(if (null? sto)
|
|
'()
|
|
(cons
|
|
(list n (car sto))
|
|
(inner-loop (cdr sto) (+ n 1)))))))
|
|
(inner-loop the-store 0))))
|