자기 평가 라켓 통역자

Question

나는 스스로 평가할 수있는 라켓 통역기를 쓰려고했지만 어떤 이유로 든 작동하지 못한다. interpreter.rkt의 코드는 꽤 표준 적입니다. interpreter-test.rkt의 코드가 문제 일 수 있습니까? 나는 잘 모르겠다.

interpreter.rkt

#lang racket 

(provide eeval) 

(define (eeval lines) 
    ; returns (key . val) if key in frame, #f otherwise 
    (define (lookup-in-frame key frame) 
    (cond 
     [(null? frame) #f] 
     [(eq? key (mcar (mcar frame))) (mcar frame)] 
     [else (lookup-in-frame key (mcdr frame))])) 

    ; returns (key . val) if key in env, #f otherwise 
    (define (lookup-in-env key env) 
    (cond 
     [(null? env) #f] 
     [else (let ([key-val-pair (lookup-in-frame key (mcar env))]) 
       (if key-val-pair 
        key-val-pair 
        (lookup-in-env key (mcdr env))))])) 

    (define (add-to-env! key value env) 
    (set-mcar! env 
       (mcons (mcons key value) 
         (mcar env)))) 

    (define (update-env! key value env) 
    (cond 
     [(null? env) 
     (error "set!: assignment disallowed; cannot set variable before its definition \nvariable:" key)] 
     [else (let ([key-val-pair (lookup-in-frame key (mcar env))]) 
       (if key-val-pair 
        (set-mcdr! key-val-pair value) 
        (update-env! key value (mcdr env))))])) 

    (define (extend-env keys values env) 
    (define (new-frame keys values) 
     (cond 
     ((null? keys) '()) 
     (else (mcons (mcons (car keys) (car values)) 
        (new-frame (cdr keys) (cdr values)))))) 
    (mcons (new-frame keys values) env)) 

    (define global-env (mcons '() '())) 

    (define (myeval expr env) 
    (cond 
     [(and (not (null? expr)) (not (pair? expr))) 
     (cond 
     [(boolean? expr) expr] 
     [(number? expr) expr] 
     [(string? expr) expr] 
     [(symbol? expr) 
      (let ([key-value (lookup-in-env expr env)]) 
      (if key-value 
       [mcdr key-value] 
       [if [member expr 
          '(void void? null? member 
            pair? list cons car cdr cddr 
            mpair? mcons mcar mcdr 
            set-mcar! set-mcdr! 
            first second third fourth 
            boolean? false? not 
            number? = + - */expt 
            string? 
            symbol? eq? equal? 
            foldl error)] 
        [lambda() (list 'primitive expr)] 
        [error expr "undefined"]]))])] 
     [(null? expr) (error "()" "missing procedure expression.")] 
     [(eq? (car expr) 'quote) 
     (second expr)] 
     [(eq? (car expr) 'lambda) 
     (lambda() (list 'non-primitive 
         (second expr) 
         (cddr expr) 
         env))] 
     [(eq? (car expr) 'define) 
     (if [not (pair? (second expr))] 
      [if [false? (lookup-in-frame (second expr) (mcar env))] 
       [add-to-env! (second expr) (myeval (third expr) env) env] 
       [error "duplicate definition for identifier in" 
         (second expr)]] 
      [myeval (list 'define 
         (car (second expr)) 
         (cons 'lambda 
           (cons (cdr (second expr)) 
            (cddr expr)))) 
        env])] 
     [(eq? (car expr) 'set!) 
     (update-env! (second expr) 
        (myeval (third expr) env) 
        env)] 
     [(eq? (car expr) 'begin) 
     (eval-sequence (cdr expr) env)] 
     [(eq? (car expr) 'cond) 
     (evcond (cdr expr) env)] 
     [(eq? (car expr) 'if) 
     (myeval (list 'cond 
        (list (second expr) (third expr)) 
        (list 'else (fourth expr))) 
       env)] 
     [(eq? (car expr) 'and) (evand (cdr expr) env)] 
     [(eq? (car expr) 'or) (evor (cdr expr) env)] 
     [(eq? (car expr) 'let) 
     (eval-sequence (cddr expr) 
         (extend-env 
         (map first (second expr)) 
         (map second (second expr)) 
         env))] 
     [else (myapply (myeval (car expr) env) 
        (eval-args (cdr expr) env))] 
    )) 

    (define (eval-sequence lines env) 
    (if [null? lines] 
     [void] 
     (if [null? (cdr lines)] 
      [myeval (car lines) env] 
      [begin (myeval (car lines) env) 
        (eval-sequence (cdr lines) env)]))) 

    (define (evcond lines env) 
    (cond 
     [(null? lines) (void)] 
     [(eq? 'else (first (car lines))) 
     (myeval (second (car lines)) env)] 
     [(myeval (first (car lines)) env) 
     (myeval (second (car lines)) env)] 
     [else (evcond (cdr lines) env)])) 

    (define (evand args env) 
    (cond 
     [(null? args) #t] 
     [(null? (cdr args)) (myeval (car args) env)] 
     [else [let ([val (myeval (car args) env)]) 
       (if [false? val] 
        #f 
        [evand (cdr args) env])]])) 

    (define (evor args env) 
    (if [null? args] 
     #f 
     [let ([val (myeval (car args) env)]) 
      (if val 
       val 
       (evor (cdr args) env))])) 

    (define (eval-args args env) 
    (cond 
     [(null? args) '()] 
     [else (cons (myeval (car args) env) 
        (eval-args (cdr args) env))])) 

    (define (myapply func vals) 
    (cond 
     [(eq? (first (func)) 'primitive) 
     (apply-primitive (second (func)) vals)] 
     [(eq? (first (func)) 'non-primitive) 
     (eval-sequence (third (func)) 
         (extend-env 
         (second (func)) 
         vals 
         (fourth (func))))] 
     [else (error func "unexpected case in myapply")])) 

    (define (apply-primitive name vals) 
    (cond 
     [(eq? name 'void) (void)] 
     [(eq? name 'void?) (void? (first vals))] 
     [(eq? name 'null?) (null? (first vals))] 
     [(eq? name 'member) (member (first vals) (second vals))] 
     [(eq? name 'pair?) (pair? (first vals))] 
     [(eq? name 'list) 
     (begin 
     (define (helper vals) 
      (if [null? vals] 
       '() 
       [cons (car vals) (helper (cdr vals))])) 
     (helper vals))] 
     [(eq? name 'cons) (cons (first vals) (second vals))] 
     [(eq? name 'car) (car (first vals))] 
     [(eq? name 'cdr) (cdr (first vals))] 
     [(eq? name 'cddr) (cddr (first vals))] 
     [(eq? name 'mpair?) (mpair? (first vals))] 
     [(eq? name 'mcons) (mcons (first vals) (second vals))] 
     [(eq? name 'mcar) (mcar (first vals))] 
     [(eq? name 'mcdr) (mcdr (first vals))] 
     [(eq? name 'set-mcar!) (set-mcar! (first vals) (second vals))] 
     [(eq? name 'set-mcdr!) (set-mcdr! (first vals) (second vals))] 
     [(eq? name 'first) (first (first vals))] 
     [(eq? name 'second) (second (first vals))] 
     [(eq? name 'third) (third (first vals))] 
     [(eq? name 'fourth) (fourth (first vals))] 
     [(eq? name 'boolean?) (boolean? (first vals))] 
     [(eq? name 'false?) (false? (first vals))] 
     [(eq? name 'not) (not (first vals))] 
     [(eq? name 'number?) (number? (first vals))] 
     [(eq? name '=) 
     (begin 
     (define (helper x l) 
      (cond 
      [(null? l) #t] 
      [(= (car l) x) (helper x (cdr l))] 
      [else #f])) 
     (if [or (null? vals) 
       (null? (cdr vals))] 
      [error "=" 
        "arity mismatch; expects at least 2 arguments."] 
      [helper (car vals) (cdr vals)]))] 
     [(eq? name '+) (foldl + 0 vals)] 
     [(eq? name '-) (- (car vals) (foldl + 0 (cdr vals)))] 
     [(eq? name '*) (foldl * 1 vals)] 
     [(eq? name '/) (/ (car vals) (foldl * 1 (cdr vals)))] 
     [(eq? name 'expt) (expt (first vals) (second vals))] 
     [(eq? name 'string?) (string? (first vals))] 
     [(eq? name 'symbol?) (symbol? (first vals))] 
     [(eq? name 'eq?) (eq? (first vals) (second vals))] 
     [(eq? name 'equal?) (equal? (first vals) (second vals))] 
     [(eq? name 'foldl) (foldl (first vals) 
           (second vals) 
           (third vals))] 
     [(eq? name 'error) (error (first vals) (second vals))])) 

    (eval-sequence lines global-env) 
) 

(eeval 
'(
    (define (even? n) 
    (if [= n 0] 
     #t 
     [odd? (- n 1)])) 

    (define (odd? n) 
    (if [= n 0] 
     #f 
     [even? (- n 1)])) 

    (define x #f) 
    (set! x (even? 6)) 
    x 
    )) 

올바른지 REPL 인쇄 #t. 다른 파일에서 다음 : - 붙여 넣은 코드에서 (require "interpreter.rkt")에서 하나 하나

interpreter-test.rkt

#lang racket 

(require "interpreter.rkt") 

(eeval 
'(
    (define (eeval lines) ...) ;; copy paste code from interpreter.rkt 
    )) 

그래서, 나는 repl을 두 번 #t를 인쇄 할 전망이다. 대신에 나는 붙여 넣은 코드에서 (require "interpreter.rkt")에서 #t하고 인정합니다 오류 메시지 :

; mcdr: contract violation 
; expected: mpair? 
; given: '(lookup-in-env expr env) 

나는 문제가 무엇인지 모른다. 따옴표가 어떻게 작동하는지와 관련이 있습니까? 모든 포인터는 감사하겠습니다.

업데이트 : 오스카 로페즈 (Oscar Lopez)는 전체 프로그램에 mcons를 사용해야 할 수도 있다고 제안했습니다. 그러나 복사 된 붙여 넣기 코드를 크게 수정해야하기 때문에 그런 종류의자가 평가 통역사의 목적을 무효화합니다. 그래서 set-car를 허용하기 때문에 대신 R5RS로 변경해 보았습니다! 그리고 set-cdr!

interpreter-r5rs.rkt

#lang R5RS 

(#%provide eeval) 

(define (eeval lines) 

    (define first car) 
    (define second cadr) 
    (define third caddr) 
    (define fourth cadddr) 

    (define (foldl proc init lst) 
    (cond 
     ((null? lst) init) 
     (else (foldl proc (proc (car lst) init) (cdr lst))))) 

    ; returns (key . val) if key in frame, #f otherwise 
    (define (lookup-in-frame key frame) 
    (cond 
     ((null? frame) #f) 
     ((eq? key (car (car frame))) (car frame)) 
     (else (lookup-in-frame key (cdr frame))))) 

    ; returns (key . val) if key in env, #f otherwise 
    (define (lookup-in-env key env) 
    (cond 
     ((null? env) #f) 
     (else (let ((key-val-pair (lookup-in-frame key (car env)))) 
       (if key-val-pair 
        key-val-pair 
        (lookup-in-env key (cdr env))))))) 

    (define (add-to-env! key value env) 
    (set-car! env 
       (cons (cons key value) 
        (car env)))) 

    (define (update-env! key value env) 
    (cond 
     ((null? env) 
     (myerror "set!: assignment disallowed; cannot set variable before its definition \nvariable:" key)) 
     (else (let ((key-val-pair (lookup-in-frame key (car env)))) 
       (if key-val-pair 
        (set-cdr! key-val-pair value) 
        (update-env! key value (cdr env))))))) 

    (define (extend-env keys values env) 
    (define (new-frame keys values) 
     (cond 
     ((null? keys) '()) 
     (else (cons (cons (car keys) (car values)) 
        (new-frame (cdr keys) (cdr values)))))) 
    (cons (new-frame keys values) env)) 

    (define global-env (cons '() '())) 

    (define (myeval expr env) 
    (cond 
     ((and (not (null? expr)) (not (pair? expr))) 
     (cond 
     ((boolean? expr) expr) 
     ((number? expr) expr) 
     ((string? expr) expr) 
     ((symbol? expr) 
      (let ((key-value (lookup-in-env expr env))) 
      (if key-value 
       (cdr key-value) 
       (if (member expr 
          '(member null? pair? 
            list cons car cdr cddr 
            set-car! set-cdr! 
            cadr caddr cadddr 
            boolean? not 
            number? = + - */expt 
            string? 
            symbol? eq? equal? 
            display)) 
        (lambda() (list 'primitive expr)) 
        (myerror expr "undefined"))))))) 
     ((null? expr) (myerror "()" "missing procedure expression.")) 
     ((eq? (car expr) 'quote) 
     (second expr)) 
     ((eq? (car expr) 'lambda) 
     (lambda() (list 'non-primitive 
         (second expr) 
         (cddr expr) 
         env))) 
     ((eq? (car expr) 'define) 
     (if (not (pair? (second expr))) 
      (if (lookup-in-frame (second expr) (car env)) 
       (myerror "duplicate definition for identifier in" 
         (second expr)) 
       (add-to-env! (second expr) (myeval (third expr) env) env)) 
      (myeval (list 'define 
         (car (second expr)) 
         (cons 'lambda 
           (cons (cdr (second expr)) 
            (cddr expr)))) 
        env))) 
     ((eq? (car expr) 'set!) 
     (update-env! (second expr) 
        (myeval (third expr) env) 
        env)) 
     ((eq? (car expr) 'begin) 
     (eval-sequence (cdr expr) env)) 
     ((eq? (car expr) 'cond) 
     (evcond (cdr expr) env)) 
     ((eq? (car expr) 'if) 
     (myeval (list 'cond 
        (list (second expr) (third expr)) 
        (list 'else (fourth expr))) 
       env)) 
     ((eq? (car expr) 'and) (evand (cdr expr) env)) 
     ((eq? (car expr) 'or) (evor (cdr expr) env)) 
     ((eq? (car expr) 'let) 
     (eval-sequence (cddr expr) 
         (extend-env 
         (map first (second expr)) 
         (map second (second expr)) 
         env))) 
     (else (myapply (myeval (car expr) env) 
        (eval-args (cdr expr) env))) 
    )) 

    (define (eval-sequence lines env) 
    (cond 
     ((not (null? lines)) 
     (if (null? (cdr lines)) 
      (myeval (car lines) env) 
      (begin (myeval (car lines) env) 
        (eval-sequence (cdr lines) env)))))) 

    (define (evcond lines env) 
    (cond 
     ((not (null? lines)) 
     (cond 
     ((eq? 'else (first (car lines))) 
      (myeval (second (car lines)) env)) 
     ((myeval (first (car lines)) env) 
      (myeval (second (car lines)) env)) 
     (else (evcond (cdr lines) env)))))) 

    (define (evand args env) 
    (cond 
     ((null? args) #t) 
     ((null? (cdr args)) (myeval (car args) env)) 
     (else (let ((val (myeval (car args) env))) 
       (if val 
        (evand (cdr args) env) 
        #f))))) 

    (define (evor args env) 
    (if (null? args) 
     #f 
     (let ((val (myeval (car args) env))) 
      (if val 
       val 
       (evor (cdr args) env))))) 

    (define (eval-args args env) 
    (cond 
     ((null? args) '()) 
     (else (cons (myeval (car args) env) 
        (eval-args (cdr args) env))))) 

    (define (myapply func vals) 
    (cond 
     ((eq? (first (func)) 'primitive) 
     (apply-primitive (second (func)) vals)) 
     ((eq? (first (func)) 'non-primitive) 
     (eval-sequence (third (func)) 
         (extend-env 
         (second (func)) 
         vals 
         (fourth (func))))) 
     (else (myerror func "unexpected case in myapply")))) 

    (define (apply-primitive name vals) 
    (define (list-helper vals) 
     (if (null? vals) 
      '() 
      (cons (car vals) (list-helper (cdr vals))))) 
    (define (=helper x l) 
     (cond 
     ((null? l) #t) 
     ((= (car l) x) (=helper x (cdr l))) 
     (else #f))) 
    (cond 
     ((eq? name 'member) (member (first vals) (second vals))) 
     ((eq? name 'null?) (null? (first vals))) 
     ((eq? name 'pair?) (pair? (first vals))) 
     ((eq? name 'list) (list-helper vals)) 
     ((eq? name 'cons) (cons (first vals) (second vals))) 
     ((eq? name 'car) (car (first vals))) 
     ((eq? name 'cdr) (cdr (first vals))) 
     ((eq? name 'cddr) (cddr (first vals))) 
     ((eq? name 'set-car!) (set-car! (first vals) (second vals))) 
     ((eq? name 'set-cdr!) (set-cdr! (first vals) (second vals))) 
     ((eq? name 'cadr) (cadr (first vals))) 
     ((eq? name 'caddr) (caddr (first vals))) 
     ((eq? name 'cadddr) (cadddr (first vals))) 
     ((eq? name 'boolean?) (boolean? (first vals))) 
     ((eq? name 'not) (not (first vals))) 
     ((eq? name 'number?) (number? (first vals))) 
     ((eq? name '=) 
     (if (or (null? vals) 
       (null? (cdr vals))) 
      (myerror "=" 
        "arity mismatch; expects at least 2 arguments.") 
      (=helper (car vals) (cdr vals)))) 
     ((eq? name '+) (foldl + 0 vals)) 
     ((eq? name '-) (- (car vals) (foldl + 0 (cdr vals)))) 
     ((eq? name '*) (foldl * 1 vals)) 
     ((eq? name '/) (/ (car vals) (foldl * 1 (cdr vals)))) 
     ((eq? name 'expt) (expt (first vals) (second vals))) 
     ((eq? name 'string?) (string? (first vals))) 
     ((eq? name 'symbol?) (symbol? (first vals))) 
     ((eq? name 'eq?) (eq? (first vals) (second vals))) 
     ((eq? name 'equal?) (equal? (first vals) (second vals))) 
     ((eq? name 'display) (display (first vals))) 
    )) 


    (define (myerror expr1 expr2) 
    (begin 
     (display expr1) 
     (display " ") 
     (display expr2) 
     (newline))) 

    (eval-sequence lines global-env) 
) 

(eeval 
'(
    (define (even? n) 
    (if (= n 0) 
     #t 
     (odd? (- n 1)))) 

    (define (odd? n) 
    (if (= n 0) 
     #f 
     (even? (- n 1)))) 

    (define x #f) 
    (set! x (even? 6)) 
    (display x) 
    )) 

interpreter-r5rs-test.rkt

#lang R5RS 

(#%require "interpreter-r5rs.rkt") 

(eeval 
'(
    (define (eeval lines) ...) ;; copy paste code from interpreter.rkt 
    )) 

하지만 그들이 있는지 확인 변경할 수쌍를 사용하는 거라면 난 여전히 오류

; application: not a procedure; 
; expected a procedure that can be applied to arguments 
; given: (mcons 'expr (mcons 'env)) 
; arguments...: [none] 

Answer 1

있어 다시 사용 전자 verywhere. 예를 들어, 다음과 같은 표현을 변환 :

(cons 'x 'y) 

을이 속으로 :

(mcons 'x 'y) 

그리고이 :

'(a b c) 

을이 속으로 :

(require compatibility/mlist) 
(mlist 'a 'b 'c) 

Answer 2

을 당신이 대표하는 것이 좋습니다 환경, 프레임 구조로서의 바인딩. 메일 링리스트 라켓 사용자에 마티아스 펠리 센에

#lang racket 
; From SICP: 
; An environment is a sequence of frames. 
(struct environment (frames) #:mutable #:transparent) 
; Each frame is a table (possibly empty) of bindings, 
; which associate variable names with their corresponding values. 
; (A single frame may contain at most one binding for any variable.) 
; Each frame also has a pointer to its enclosing environment, unless, 
; for the purposes of discussion, the frame is considered to be global. 
(struct frame (bindings parent) #:mutable #:transparent) 
; The value of a variable with respect to an environment is the value 
; given by the binding of the variable in the first frame in the environment 
; that contains a binding for that variable. 
(struct binding (key value) #:mutable #:transparent) 
; If no frame in the sequence specifies a binding for the variable, 
; then the variable is said to be unbound in the environment. 

(define (lookup-in-env key env) 
    (match env 
    [(environment frames) 
    (lookup-in-frames key frames)])) 

(define (lookup-in-frames key frames) 
    (match frames 
    ['()   #f] ; unbound 
    [(cons f fs) (or (lookup-in-frame key f) 
        (lookup-in-frames key fs))])) 

(define (lookup-in-frame key f) 
    (match f 
    [(frame bindings parent) 
    (lookup-in-bindings key bindings)])) 

(define (lookup-in-bindings key bindings) 
    (match bindings 
    ['()   #f] ; unbound 
    [(cons b bs) (if (eq? key (binding-key b)) 
        b ; binding with key-value paring 
        (lookup-in-bindings key bs))])) 

(define (add-frame-to-env! f env) 
    (match env 
    [(environment frames) 
    (set-environment-frames! env (cons f frames))])) 

(define (update-env! key value env) 
    (let ([b (lookup-in-env key env)]) 
    (if b 
     (set-binding-value! b value) 
     (error 'update-env! (~a "no binding for " key))))) 

(define (extend-env keys values env) 
    (match env 
    [(environment (cons top-frame frames)) 
    (define bs (map binding keys values)) 
    (define new-f (frame bs top-frame)) 
    (set-environment-frames! env (cons new-f (cons top-frame frames)))])) 

(define global-env (environment (list (frame '() #f)))) 

(lookup-in-env '+ global-env) ; #f since plus is unbound 
(extend-env '(+ - * /) (list + - * /) global-env) 
(lookup-in-env '+ global-env) 

Answer 3

감사합니다 : https://groups.google.com/forum/#!topic/racket-users/aFfGgh7Rfgc, 나는 문제를 발견했다. 그것은 단점, mcons 또는 따옴표와 아무런 관련이 없습니다.

문제는 interpreter.rkt의 실수였습니다. 통역관에서.RKT, myeval의 정의에 따라, 렛 표현의 경우, 그것은 있었어야 :

[(eq? (car expr) 'let) 
(eval-sequence (cddr expr) 
       (extend-env 
       (map first (second expr)) 
       (eval-args (map second (second expr)) env) 
       env))] 

또한, 어떤 이유로 작동하지 않습니다 내장 foldl를 사용하여. 스스로를 정의 및 내장 함수 목록에서 제거하는 것은 작동합니다

(define (foldl proc init lst) 
    (cond 
    ((null? lst) init) 
    (else (foldl proc (proc (car lst) init) (cdr lst))))) 

interpreter.rkt

#lang racket 

(provide eeval) 

(define (eeval lines) 

    ;; The global environment is a mutable list of frames, 
    ;; where each frame is a mutable list of 
    ;; mutable variable-value pairs. 
    ;; When a function is called, it creates a new frame 
    ;; which is a mutable list of parameter-argument pairs. 
    ;; Then it mcons the new frame to the enviroment the 
    ;; function was defined in. 
    (define global-env (mcons '() '())) 

    ; returns (mcons key val) if key in frame, #f otherwise 
    (define (lookup-in-frame key frame) 
    (cond 
     [(null? frame) #f] 
     [(eq? key (mcar (mcar frame))) (mcar frame)] 
     [else (lookup-in-frame key (mcdr frame))])) 

    ; returns (mcons key val) if key in env, #f otherwise 
    (define (lookup-in-env key env) 
    (cond 
     [(null? env) #f] 
     [else (let ([key-val-pair (lookup-in-frame key (mcar env))]) 
       (if key-val-pair 
        key-val-pair 
        (lookup-in-env key (mcdr env))))])) 

    (define (add-to-env! key value env) 
    (set-mcar! env 
       (mcons (mcons key value) 
         (mcar env)))) 

    (define (update-env! key value env) 
    (cond 
     [(null? env) 
     (error "set!: assignment disallowed; cannot set variable before its definition \nvariable:" key)] 
     [else (let ([key-val-pair (lookup-in-frame key (mcar env))]) 
       (if key-val-pair 
        (set-mcdr! key-val-pair value) 
        (update-env! key value (mcdr env))))])) 

    (define (extend-env keys values env) 
    (define (new-frame keys values) 
     (cond 
     ((null? keys) '()) 
     (else (mcons (mcons (car keys) (car values)) 
        (new-frame (cdr keys) (cdr values)))))) 
    (mcons (new-frame keys values) env)) 

    (define (myeval expr env) 
    (cond 
     [(and (not (null? expr)) (not (pair? expr))) 
     (cond 
     [(boolean? expr) expr] 
     [(number? expr) expr] 
     [(string? expr) expr] 
     [(symbol? expr) 
      (let ([key-value (lookup-in-env expr env)]) 
      (if key-value 
       [mcdr key-value] 
       [if [member expr 
          '(void void? null? member 
            pair? list cons car cdr cddr 
            mpair? mcons mcar mcdr 
            set-mcar! set-mcdr! 
            first second third fourth 
            boolean? false? not 
            number? = + - */expt 
            string? 
            symbol? eq? equal? 
            display error)] 
        [lambda() (list 'primitive expr)] 
        [error expr "undefined"]]))])] 
     [(null? expr) (error "()" "missing procedure expression.")] 
     [(eq? (car expr) 'quote) 
     (second expr)] 
     [(eq? (car expr) 'lambda) 
     (lambda() (list 'non-primitive 
         (second expr) 
         (cddr expr) 
         env))] 
     [(eq? (car expr) 'define) 
     (if [not (pair? (second expr))] 
      [if [false? (lookup-in-frame (second expr) (mcar env))] 
       [add-to-env! (second expr) (myeval (third expr) env) env] 
       [error "duplicate definition for identifier in" 
         (second expr)]] 
      [myeval (list 'define 
         (car (second expr)) 
         (cons 'lambda 
           (cons (cdr (second expr)) 
            (cddr expr)))) 
        env])] 
     [(eq? (car expr) 'set!) 
     (update-env! (second expr) 
        (myeval (third expr) env) 
        env)] 
     [(eq? (car expr) 'begin) 
     (eval-sequence (cdr expr) env)] 
     [(eq? (car expr) 'cond) 
     (evcond (cdr expr) env)] 
     [(eq? (car expr) 'if) 
     (myeval (list 'cond 
        (list (second expr) (third expr)) 
        (list 'else (fourth expr))) 
       env)] 
     [(eq? (car expr) 'and) (evand (cdr expr) env)] 
     [(eq? (car expr) 'or) (evor (cdr expr) env)] 
     [(eq? (car expr) 'let) 
     (eval-sequence (cddr expr) 
         (extend-env 
         (map first (second expr)) 
         (eval-args (map second (second expr)) env) 
         env))] 
     [else (myapply (myeval (car expr) env) 
        (eval-args (cdr expr) env))] 
    )) 

    (define (eval-sequence lines env) 
    (if [null? lines] 
     [void] 
     (if [null? (cdr lines)] 
      [myeval (car lines) env] 
      [begin (myeval (car lines) env) 
        (eval-sequence (cdr lines) env)]))) 

    (define (evcond lines env) 
    (cond 
     [(null? lines) (void)] 
     [(eq? 'else (first (car lines))) 
     (myeval (second (car lines)) env)] 
     [(myeval (first (car lines)) env) 
     (myeval (second (car lines)) env)] 
     [else (evcond (cdr lines) env)])) 

    (define (evand args env) 
    (cond 
     [(null? args) #t] 
     [(null? (cdr args)) (myeval (car args) env)] 
     [else [let ([val (myeval (car args) env)]) 
       (if [false? val] 
        #f 
        [evand (cdr args) env])]])) 

    (define (evor args env) 
    (if [null? args] 
     #f 
     [let ([val (myeval (car args) env)]) 
      (if val 
       val 
       (evor (cdr args) env))])) 

    (define (eval-args args env) 
    (cond 
     [(null? args) '()] 
     [else (cons (myeval (car args) env) 
        (eval-args (cdr args) env))])) 

    (define (myapply func vals) 
    (cond 
     [(eq? (first (func)) 'primitive) 
     (apply-primitive (second (func)) vals)] 
     [(eq? (first (func)) 'non-primitive) 
     (eval-sequence (third (func)) 
         (extend-env 
         (second (func)) 
         vals 
         (fourth (func))))] 
     [else (error func "unexpected case in myapply")])) 

    (define (apply-primitive name vals) 
    (cond 
     [(eq? name 'void) (void)] 
     [(eq? name 'void?) (void? (first vals))] 
     [(eq? name 'null?) (null? (first vals))] 
     [(eq? name 'member) (member (first vals) (second vals))] 
     [(eq? name 'pair?) (pair? (first vals))] 
     [(eq? name 'list) 
     (begin 
     (define (helper vals) 
      (if [null? vals] 
       '() 
       [cons (car vals) (helper (cdr vals))])) 
     (helper vals))] 
     [(eq? name 'cons) (cons (first vals) (second vals))] 
     [(eq? name 'car) (car (first vals))] 
     [(eq? name 'cdr) (cdr (first vals))] 
     [(eq? name 'cddr) (cddr (first vals))] 
     [(eq? name 'mpair?) (mpair? (first vals))] 
     [(eq? name 'mcons) (mcons (first vals) (second vals))] 
     [(eq? name 'mcar) (mcar (first vals))] 
     [(eq? name 'mcdr) (mcdr (first vals))] 
     [(eq? name 'set-mcar!) (set-mcar! (first vals) (second vals))] 
     [(eq? name 'set-mcdr!) (set-mcdr! (first vals) (second vals))] 
     [(eq? name 'first) (first (first vals))] 
     [(eq? name 'second) (second (first vals))] 
     [(eq? name 'third) (third (first vals))] 
     [(eq? name 'fourth) (fourth (first vals))] 
     [(eq? name 'boolean?) (boolean? (first vals))] 
     [(eq? name 'false?) (false? (first vals))] 
     [(eq? name 'not) (not (first vals))] 
     [(eq? name 'number?) (number? (first vals))] 
     [(eq? name '=) 
     (begin 
     (define (helper x l) 
      (cond 
      [(null? l) #t] 
      [(= (car l) x) (helper x (cdr l))] 
      [else #f])) 
     (if [or (null? vals) 
       (null? (cdr vals))] 
      [error "=" 
        "arity mismatch; expects at least 2 arguments."] 
      [helper (car vals) (cdr vals)]))] 
     [(eq? name '+) (foldl + 0 vals)] 
     [(eq? name '-) (- (car vals) (foldl + 0 (cdr vals)))] 
     [(eq? name '*) (foldl * 1 vals)] 
     [(eq? name '/) (/ (car vals) (foldl * 1 (cdr vals)))] 
     [(eq? name 'expt) (expt (first vals) (second vals))] 
     [(eq? name 'string?) (string? (first vals))] 
     [(eq? name 'symbol?) (symbol? (first vals))] 
     [(eq? name 'eq?) (eq? (first vals) (second vals))] 
     [(eq? name 'equal?) (equal? (first vals) (second vals))] 
;  [(eq? name 'foldl) (foldl (first vals) 
;        (second vals) 
     ;        (third vals))] 
     ((eq? name 'display) (display (first vals))) 
     [(eq? name 'error) (error (first vals) (second vals))])) 

    (define (foldl proc init lst) 
    (cond 
     ((null? lst) init) 
     (else (foldl proc (proc (car lst) init) (cdr lst))))) 

    (define (eval-print-sequence lines) 
    (if [null? lines] 
     [void] 
     [let ([result (myeval (car lines) global-env)]) 
      (if [void? result] 
       [eval-print-sequence (cdr lines)] 
       [begin (display result) 
        (display "\n") 
        (eval-print-sequence (cdr lines))])])) 

    (eval-print-sequence lines) 
) 

(eeval 
'(
    (define (even? n) 
    (if [= n 0] 
     #t 
     [odd? (- n 1)])) 

    (define (odd? n) 
    (if [= n 0] 
     #f 
     [even? (- n 1)])) 

    (define x #f) 
    (set! x (even? 6)) 
    x 
    ))