jwb@cepmax.ncsu.EDU (John W. Baugh Jr.) (09/27/90)
In trying to get some of the SICP code running in Scheme->C,
I used the following definitions and macros, which (presumably
help to) convert MIT Scheme code into R3RS. I don't claim to
be an expert in either dialect (or in Scheme in general for
that matter), so if any of you have comments I'd gladly
entertain them.
John Baugh
jwb@cepmax.ncsu.edu
;;; Some MIT Scheme Extensions/Changes to Scheme->C
; Note: you should
; replace (1+ x) with (+ x 1) since 1+ cannot be parsed
; replace (eval exp env) with (eval exp)
(define nil '())
(define t #t)
(define (atom? x) (not (pair? x)))
(define princ display)
(define (print expression)
(newline)
(write expression))
(define-macro sequence
(lambda (form expander)
(expander
`(begin ,@(cdr form))
expander)))
(define r3rs-assoc assoc)
(define (assoc obj alist)
(or (r3rs-assoc obj alist) '()))
(define r3rs-assq assq)
(define (assq obj alist)
(or (r3rs-assq obj alist) '()))
(define r3rs-assv assv)
(define (assv obj alist)
(or (r3rs-assv obj alist) '()))
(define r3rs-member member)
(define (member expression list)
(or (r3rs-member expression list) '()))
(define r3rs-memq memq)
(define (memq expression list)
(or (r3rs-memq expression list) '()))
(define r3rs-memv memv)
(define (memv expression list)
(or (r3rs-memv expression list) '()))
(define r3rs-not not)
(define (not expression)
(or (r3rs-not expression) '()))
(define (char->string c)
(make-string 1 c))
(define (char->symbol c)
(string->symbol (char->string c)))
(define (symbol->char s)
(string-ref (symbol->string s) 0))
(define (explode symbol)
(map char->symbol (string->list (symbol->string symbol))))
(define (implode list-of-symbols)
(string->symbol (list->string (map symbol->char list-of-symbols))))
(define put putprop)
(define (get symbol expression)
(or (getprop symbol expression) '()))
(define cons-stream cons)
(define singleton list)
(define head car)
(define tail cdr)
(define the-empty-stream '())
(define empty-stream? null?)
(define append-streams append)
(define (accumulate combiner initial-value stream)
(if (empty-stream? stream)
initial-value
(combiner (head stream)
(accumulate combiner
initial-value
(tail stream)))))
(define (flatten stream)
(accumulate append-streams the-empty-stream stream))
(define (flatmap f s)
(flatten (map f s)))
(define (interleave-delayed s1 delayed-s2)
(if (empty-stream? s1)
(force delayed-s2)
(cons-stream (head s1)
(interleave-delayed (force delayed-s2)
(delay (tail s1))))))