remove dead code and update testing functions
This commit is contained in:
@@ -170,66 +170,6 @@
|
||||
(let ([v0 (uniq-var v)])
|
||||
(values (environment-extend r (list (cons v v0))) v0)))
|
||||
|
||||
(define (cps-aexp expr r)
|
||||
(match expr
|
||||
[('lambda (v* ...) e)
|
||||
(let-values
|
||||
([($k) (gensym "$k-")]
|
||||
[(r0 v*0) (uniq-names r v*)])
|
||||
`(lambda (,@v*0 ,$k) ,(cps-cexp-fo e $k r0)))]
|
||||
[(? primitive?) `(cps-prim ,expr)]
|
||||
((? symbol?)
|
||||
(let ([kons (environment-assq r expr)])
|
||||
(if kons (cdr kons) (signal-exception "Undefined variable:" expr))))
|
||||
[(? atomic?) expr]))
|
||||
|
||||
(define (cps-cexp-fo expr c r)
|
||||
(match expr
|
||||
[ ('quote _) `(,c ,expr)]
|
||||
[`(lambda . ,_) `(,c ,(cps-aexp expr r))]
|
||||
[ (? atomic?) `(,c ,(cps-aexp expr r))]
|
||||
[ (f e* ...)
|
||||
(cps-cexp-ho
|
||||
f
|
||||
(lambda ($f)
|
||||
(cps-cexp-map
|
||||
e*
|
||||
(lambda ($e*)
|
||||
`(,$f ,@$e* ,c))
|
||||
r))
|
||||
r)]))
|
||||
|
||||
(define (cps-cexp-ho expr k r)
|
||||
(match expr
|
||||
[ ('quote _) (k expr)]
|
||||
[`(lambda . ,_) (k (cps-aexp expr r))]
|
||||
[ (? atomic?) (k (cps-aexp expr r))]
|
||||
[ (f e* ...)
|
||||
(let ([$rv (gensym "$rv-")])
|
||||
(cps-cexp-ho
|
||||
f
|
||||
(lambda ($f)
|
||||
(cps-cexp-map
|
||||
e*
|
||||
(lambda ($e*)
|
||||
`(,$f ,@$e* (lambda (,$rv) ,(k $rv))))
|
||||
r))
|
||||
r))]))
|
||||
|
||||
(define (cps-cexp-map exprs k r)
|
||||
;; exp* * (aexp -> cexp) -> cexp
|
||||
(if (pair? exprs)
|
||||
(cps-cexp-ho
|
||||
(car exprs)
|
||||
(lambda ($e)
|
||||
(cps-cexp-map
|
||||
(cdr exprs)
|
||||
(lambda ($e*)
|
||||
(k (cons $e $e*)))
|
||||
r))
|
||||
r)
|
||||
(k '())))
|
||||
|
||||
(define (M expr r)
|
||||
;; M dispatches to the appropriate transformer
|
||||
;; expr -> aexp
|
||||
@@ -348,6 +288,10 @@
|
||||
[(args ... k) (k (apply x args))])
|
||||
x))
|
||||
|
||||
(define (set-then! v e k)
|
||||
(set! v e)
|
||||
(k undefined-value))
|
||||
|
||||
(define (ir-interpreter)
|
||||
(display "> ")
|
||||
(let ([prgm (read)])
|
||||
|
||||
Reference in New Issue
Block a user