From e4fe2c6bffb7abab961576e957549392b8554ea6 Mon Sep 17 00:00:00 2001 From: Dane Johnson Date: Wed, 4 Feb 2026 11:35:14 -0600 Subject: [PATCH] remove dead code and update testing functions --- scmvm/language/scheme.scm | 64 +++------------------------------------ 1 file changed, 4 insertions(+), 60 deletions(-) diff --git a/scmvm/language/scheme.scm b/scmvm/language/scheme.scm index 4ce81f1..63c54e0 100644 --- a/scmvm/language/scheme.scm +++ b/scmvm/language/scheme.scm @@ -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)])