(define atom? (lambda (val) (not (pair? val)))) (define subst (lambda (replacement val exp) (if (atom? exp) (if (eq? val exp) replacement exp) (cons (subst replacement val (car exp)) (subst replacement val (cdr exp)))))) (define sub2 (lambda (x z) (cond ((null? x) z) ((eq? (caar x) z) (cadar x)) (#t (sub2 (cdr x) z))))) (define sublis (lambda (x y) (cond ((atom? y) (sub2 x y)) (#t (cons (sublis x (car y)) (sublis x (cdr y))))))) (define assoc (lambda (x y) (cond ; ((null? y) x) ((eq?(caar y) x) (cadar y)) (#t (assoc x (cdr y)))))) (define pair (lambda (x y) (cond ((and (null? x) (null? y)) null) ((and (not (atom? x)) (not (atom? y))) (cons (list (car x) (car y)) (pair (cdr x) (cdr y))))))) (define report (lambda vals (display "[") (display vals) (display "]") (newline))) (define atom (lambda (e) (if (pair? e) 'f 't))) (define eq (lambda (a b) (if (eq? a b) 't 'f))) (define sval (lambda (e a) (report 'sval e a) (cond ; If the s-expression is an atom, ; Look it up in the "symbol table" ((atom? e) (assoc e a)) ; The expression is a list, which means ... ; The application of an operator to some ; operands ; Simple version: A symbolic operator ; * The seven basic ones ; * A name introduced by the user ((atom? (car e)) (cond ; Predicates ((eq? (car e) 'atom) (atom (sval (cadr e) a))) ((eq? (car e) 'eq) (eq (sval (cadr e) a) (sval (caddr e) a))) ; List ((eq? (car e) 'cons) (cons (sval (cadr e) a) (sval (caddr e) a))) ((eq? (car e) 'car) (car (sval (cadr e) a))) ((eq? (car e) 'cdr) (cdr (sval (cadr e) a))) ; Control ((eq? (car e) 'quote) (cadr e)) ; Cond has a lot of length-two lists as parameters ((eq? (car e) 'cond) (scond (cdr e) a)) ; User-defined (#t (sval (cons (assoc (car e) a) (cdr e)) a)))) ; What if it's the application of a lambda? ; ((lambda params body) arg1 ... argn) ; Substitute the formals for the actuals, ; then evaluate the body ((eq? 'lambda (caar e)) (sval (caddar e) (append (pair (cadar e) (evlis (cdr e) a)) a))) (else (error "Cannot evaluate"))))) (define scond (lambda (e a) (report 'scond e a) (if (null? e) (error "Ran out of conditions!") (if (eq? (sval (caar e) a) 't) (sval (cadar e) a) (scond (cdr e) a))))) ;(define eeval ; (lambda (e a) ; (report 'eeval e a) ; (cond ; ((atom? e) (assoc e a)) ; ((atom? (car e)) ; (cond ; ((eq? (car e) 'quote) (cadr e)) ; ((eq? (car e) 'atom) (atom? (eeval (cadr e) a))) ; ((eq? (car e) 'eq) (eq? (eval (cadr e) a) (eeval (caddr e) a))) ; ((eq? (car e) 'cond) (evcon (cdr e) a)) ; ((eq? (car e) 'car) (car (eeval (cadr e) a))) ; ((eq? (car e) 'cdr) (cdr (eeval (cadr e) a))) ; ((eq? (car e) 'cons) (cons (eeval (cadr e) a) (eeval (caddr e) a))) ; (#t (eeval (cons (assoc (car e) a) ; (evlis (cdr e) a)) ; a)))) ; ; The Label case ; ; e is ((label name body) arg1 ... argn) ; ; (car e) is ('label name body) ; ; (caar e) is 'label ; ; (cdr e) is (arg1 ... argn) ; ; (caddar e) is body ; ; (cadar e) is name ; ((eq? (caar e) 'label) ; (eeval (cons (caddar e) (cdr e)) ; (cons (list (cadar e) (car e)) a))) ; ; The lambda case ; ; e is ((lambda params body) args) ; ; (caar e) is 'lambda ; ; (caddar e) is body ; ; (cadar e) is params ; ; (cdr e) is args ; ((eq? (caar e) 'lambda) ; (eeval (caddar e) ; (append (pair (cadar e) ; (evlis (cdr e) a)) ; a))) ; ; The remainder ; (else 'error)))) ; (define evcon (lambda (c a) (report 'evcon c a) (cond ((eeval (caar c) a) (eeval (cadar c) a)) (#t (evcon (cdr c) a))))) (define evlis (lambda (m a) (report 'evlis m a) (cond ((null? m) null) (#t (cons (sval (car m) a) (evlis (cdr m) a)))))) (define envt (list (list 'nil null) (list 'T #t))) (define ff '(label ff (lambda (x) (cond ((atom x) x) (T (ff (car x))))))) (define foo '(lambda (x p f u) (cond)))