自分自身を評価できる Racket インタープリターを作成しようとしていますが、何らかの理由で動作させることができません。のコード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
))
#t正しいreplプリント。次に、別のファイルで:
interpreter-test.rkt
#lang racket
(require "interpreter.rkt")
(eeval
'(
(define (eeval lines) ... ) ;; copy paste code from interpreter.rkt
))
したがって、repl が#t2 回印刷されることを期待してい(require "interpreter.rkt")ます。代わりに、貼り付けたコード#tから(require "interpreter.rkt")、役に立たないエラー メッセージが表示されます。
; mcdr: contract violation
; expected: mpair?
; given: '(lookup-in-env expr env)
何が問題なのかわかりません。引用符の動作と関係がありますか? 任意のポインタをいただければ幸いです。
更新: Oscar Lopez は、プログラム全体で mcons を使用する必要があるかもしれないと提案しました。ただし、コピーペーストされたコードを大幅に変更する必要があるため、この種の自己評価型インタープリターの目的は無効になります。ということで、セットカーができる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]