home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-386-Vol-2of3.iso
/
c
/
cr-macro.zip
/
UTILS.SCM
< prev
Wrap
Text File
|
1990-02-18
|
2KB
|
79 lines
; Utilities (need to be loaded before interpreter)
; THE FOLLOWING THREE DEFINITIONS ARE IMPLEMENTATION-DEPENDENT
(define scheme-eval
;; #'schi:scheme-eval ; Pseudoscheme
(*value t-standard-env 'eval) ; T
;; (access-scheme-48 'eval) ; Scheme-48
)
(define (make-transformer-environment)
;; schi:usual-context ; Pseudoscheme
((*value t-standard-env 'make-locale) scheme-env 'transformer-env) ; T
;; (access-scheme-48 'user-initial-environment) ;Scheme-48
)
; Most Schemes already have some kind of ERROR form defined.
; (define error (access-scheme-48 'error))
; Evaluate an expression written in the transformer language
(define (eval-transformer exp env)
(let ((exp (if (and (pair? exp)
(eq? (car exp) 'syntax-rules))
(rewrite-syntax-rules exp (lambda (x) x) eq?)
exp)))
(scheme-eval exp env)))
(define (syntax-error message form)
(error message form))
; In lieu of define-record-type
(define (vector-predicate type-name)
(lambda (obj)
(and (vector? obj)
(> (vector-length obj) 0)
(eq? (vector-ref obj 0) type-name))))
(define (vector-accessor type-name index)
(let ((pred (vector-predicate type-name)))
(lambda (obj)
(if (pred obj)
(vector-ref obj index)
(error "bad argument" type-name obj)))))
(define (vector-updater type-name index)
(let ((pred (vector-predicate type-name)))
(lambda (obj val)
(if (pred obj)
(vector-set! obj index val)
(error "bad argument" type-name obj)))))
; Misc.
(define (any pred l)
(and (not (null? l))
(or (pred (car l))
(any pred (cdr l)))))
(define (right-assq x l)
(if (null? l)
#f
(if (eq? x (cdar l))
(car l)
(right-assq x (cdr l)))))
(define (make-table)
(list 'table))
(define (table-ref table key)
(let ((probe (assq key (cdr table))))
(if probe
(cdr probe)
#f)))
(define (table-set! table key value)
(set-cdr! table (cons (cons key value) (cdr table))))