I am trying to implement an interpreter in scheme. For now i implemented some part of it, but i am having problems with "if" statement. Here is the grammar:
<s6> -> <expr>
| <define>
<define> -> ( define IDENT <expr> )
<expr> -> NUMBER
| IDENT
| <if>
<if> -> ( if <expr> <expr> <expr> )
Here is the code i have written so far:
(define get-operator (lambda (op-symbol)
(cond
((equal? op-symbol '+) +)
((equal? op-symbol '-) -)
((equal? op-symbol '*) *)
((equal? op-symbol '/) /)
(else (error "s6-interpret: operator not implemented -->" op-symbol)))))
(define if-stmt? (lambda (e)
(and (list? e) (equal? (car e) 'if) (= (length e) 4))))
(define define-stmt? (lambda (e)
(and (list? e) (equal? (car e) 'define) (symbol? (cadr e)) (= (length e) 3))))
(define get-value (lambda (var env)
(cond
((null? env) (error "s6-interpret: unbound variable -->" var))
((equal? (caar env) var) (cdar env))
(else (get-value var (cdr env))))))
(define extend-env (lambda (var val old-env)
(cons (cons var val) old-env)))
(define repl (lambda (env)
(let* (
(dummy1 (display "cs305> "))
(expr (read))
(new-env (if (define-stmt? expr)
(extend-env (cadr expr) (s6-interpret (caddr expr) env) env)env))
(val (if (define-stmt? expr)
(cadr expr)
(s6-interpret expr env)))
(dummy2 (display "cs305: "))
(dummy3 (display val))
(dummy4 (newline))
(dummy4 (newline)))
(repl new-env))))
(define s6-interpret (lambda (e env)
(cond
((number? e) e)
((symbol? e) (get-value e env))
((not (list? e)) (error "s6-interpret: cannot evaluate -->" e))
(if-stmt? e) (if (eq? (cadr e) 0) (map s6-interpret (cadddr e)) (map s6-interpret(caddr e))))
(else
(let ((operands (map s6-interpret (cdr e) (make-list (length (cdr e)) env)))
(operator (get-operator (car e))))
(apply operator operands))))))
(define cs305-interpreter (lambda () (repl '())))
The define statement works well. My code also includes implementation of some basic math operators, you can ignore them. My problem is, the "if" statement i implemented does not work as i expect. When i write "(if 1 (+ 2 5) 9)" it prints out (+ 2 5) but actually i want it to print out 7, which is 2+5. I think there is a problem about my recursion. Can anyone help me with this?
Thank you
The code you have written for if statements never triggers, because if statements are lists of length 4, not 3:
(define if-stmt? (lambda (e)
(and (list? e)
(equal? (car e) 'if)
(= (length e) 3))))
> (length '(if condition then-clause else-clause))
4
> (if-stmt? '(if condition then-clause else-clause))
#f
It would probably make more sense to accept any list that starts with the symbol "if" as an if statement. If it doesn't have a legal length, that just means it's a broken if statement, not that it's something else entirely (unless the language you're writing an interpreter for is unusual for a Lisp in this respect).
There is indeed also something wrong with your recursion, in that you're not using it in this case. When if-stmt? triggers, you are not calling s6-interpret again. The following would be closer to correct:
((if-stmt? e)
(s6-interpret
(if (eq? (cadr e) 0)
(cadddr e)
(caddr e))
env))
Note that there are also other irregularities with your implementation, including the if statement. For instance, it is not conventional that "0" evaluates as false, and certainly very unconventional that #f evaluates as true.
Check what the Scheme implementation actually does to see what is considered conventional/correct. You can also refer to R5RS, which is comparatively short and readable for a language specification.
A few hints about code legibility:
You should use conventional indentation. This will make your code easier to read. If you're using a Scheme-aware editor, the editor can likely help you with this. For instance, in DrRacket, just press "tab" when at the start of a line and this line will be fixed for you. You'll need to insert newlines as appropriate.
Scheme has a syntax especially for defining functions. Use it. You have likely been taught that you could implement everything by binding lambdas to symbol names -- functions are not special. That's an important theoretical point, but it's not a good idea to do this in practice. The following are essentially equivalent, but the latter is shorter and easier to read.
(define f (lambda (a b) (+ a b)))
(define (f a b) (+ a b))
Related
Here is my code about postfix in scheme:
(define (stackupdate e s)
(if (number? e)
(cons e s)
(cons (eval '(e (car s) (cadr s))) (cddr s))))
(define (postfixhelper lst s)
(if (null? lst)
(car s)
(postfixhelper (cdr lst) (stackupdate (car lst) s))))
(define (postfix list)
(postfixhelper list '()))
(postfix '(1 2 +))
But when I tried to run it, the compiler said it takes wrong. I tried to check it, but still can't find why it is wrong. Does anyone can help me? Thanks so much!
And this is what the compiler said:
e: unbound identifier;
also, no #%app syntax transformer is bound in: e
eval never has any information about variables that some how are defined in the same scope as it is used. Thus e and s does not exist. Usually eval is the wrong solution, but if you are to use eval try doing it as as little as you can:
;; Use eval to get the global procedure
;; from the host scheme
(define (symbol->proc sym)
(eval sym))
Now instead of (eval '(e (car s) (cadr s))) you do ((symbol->proc e) (car s) (cadr s)). Now you should try (postfix '(1 2 pair?))
I've made many interpreters and none of them used eval. Here is what I would have done most of the time:
;; Usually you know what operators are supported
;; so you can map their symbol with a procedure
(define (symbol->proc sym)
(case sym
[(+) +]
[(hyp) (lambda (k1 k2) (sqrt (+ (* k1 k1) (* k2 k2))))]
[else (error "No such operation" sym)]))
This fixes the (postfix '(1 2 pair?)) problem. A thing that I see in your code is that you always assume two arguments. But how would you do a double? eg something that just doubles the one argument. In this case symbol->proc could return more information:
(define (symbol->op sym)
(case sym
[(+) (cons + 2)]
[(double) (cons (lambda (v) (* v v)) 1)]
[else (error "No such operation" sym)]))
(define op-proc car)
(define op-arity cdr)
And in your code you could do this if it's not a number:
(let* ([op (symbol->op e)]
[proc (op-proc op)]
[arity (op-arity op)])
(cons (apply proc (take s arity)
(drop s arity)))
take and drop are not R5RS, but they are simple to create.
In "The Scheme Programming Language 4th Edition" section 3.3 Continuations the following example is given:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
I can confirm it works in chezscheme as written:
> (product '(1 2 3 4 5))
120
What is 'f' in the above let? Why is the given ls being assigned to itself? It doesn't seem to match what I understand about (let ...) as described in 4.4 local binding:
syntax: (let ((var expr) ...) body1 body2 ...)
If 'f' is being defined here I would expect it inside parenthesis/square brackets:
(let ([f some-value]) ...)
This is 'named let', and it's a syntactic convenience.
(let f ([x y] ...)
...
(f ...)
...)
is more-or-less equivalent to
(letrec ([f (λ (x ...)
...
(f ...)
...)])
(f y ...))
or, in suitable contexts, to a local define followed by a call:
(define (outer ...)
(let inner ([x y] ...)
...
(inner ...)
...))
is more-or-less equivalent to
(define (outer ...)
(define (inner x ...)
...
(inner ...)
...)
(inner y ...))
The nice thing about named let is that it puts the definition and the initial call of the local function in the same place.
Cavemen like me who use CL sometimes use macros like binding, below, to implement this (note this is not production code: all its error messages are obscure jokes):
(defmacro binding (name/bindings &body bindings/decls/forms)
;; let / named let
(typecase name/bindings
(list
`(let ,name/bindings ,#bindings/decls/forms))
(symbol
(unless (not (null bindings/decls/forms))
(error "a syntax"))
(destructuring-bind (bindings . decls/forms) bindings/decls/forms
(unless (listp bindings)
(error "another syntax"))
(unless (listp decls/forms)
(error "yet another syntax"))
(multiple-value-bind (args inits)
(loop for binding in bindings
do (unless (and (listp binding)
(= (length binding) 2)
(symbolp (first binding)))
(error "a more subtle syntax"))
collect (first binding) into args
collect (second binding) into inits
finally (return (values args inits)))
`(labels ((,name/bindings ,args
,#decls/forms))
(,name/bindings ,#inits)))))
(t
(error "yet a different syntax"))))
f is bound to a procedure that has the body of let as a body and ls as a parameter.
http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_sec_11.16
Think of this procedure:
(define (sum lst)
(define (helper lst acc)
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc))))
(helper lst 0))
(sum '(1 2 3)) ; ==> 6
We can use named let instead of defining a local procedure and then use it like this:
(define (sum lst-arg)
(let helper ((lst lst-arg) (acc 0))
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc)))))
Those are the exact same code with the exception of some duplicate naming situations. lst-arg can have the same name lst and it is never the same as lst inside the let.
Named let is easy to grasp. call/ccusually takes some maturing. I didn't get call/cc before I started creating my own implementations.
Frequently, I find I want to compute a series of values conditionally depending on the value of previous values. For example, let's call these values x, y and z. First I compute x. If x meets certain criteria, then I compute y, which is function of x, and so on. Schematically,
;; compute value x
;; if x =? #f -> #f
;; else compute value y = f(x)
;; if y =? #f -> #f
;; else compute value z = f(y)
;; et cetera
How do you do this in Scheme? I think typically one would use cond but cond throws away the results of the tests, therefore it's no use in this situation.
Use let*, which evaluates the initialization forms sequentially, in the scope of the brevious bindings. In the initialization forms, use and to make the calculation conditional.
(let* ((x (compute-x))
(y (and x (f1 x)))
(z (and y (f2 y))))
;; code that uses the variables
)
You could make use of the => device in the cond clauses, for example:
(define (testing p x)
(if (p x)
x
#f))
(display
(cond
((testing even? 1) => (lambda (x) ; the clause is skipped
(list 10 x)))
((testing even? 2) => (lambda (x) ; the clause is entered and
(list 20 x))))) ; `x` is bound to 2
You would have nested cond(s) in the corresponding clause(s), to represent the nested conditions like you describe.
This way the code structure manifestly follows your logic, which is always good.
So you're code can be written like this in standard Common Lisp:
(let ((it x-expression))
(if it
(let ((it (f it)))
(if it
it))))
Notice I'm not giving an else-form (alternative) since it is optional in CL.
Paul Graham introduces Anaphoric macros in a way to automatic cache the test value.
(defmacro aif (test-form then-form &optional else-form)
`(let ((it ,test-form))
(if it ,then-form ,else-form)))
(aif x-expression
(aif (f it)
(aif (f it)
it)
This works well in CL, but it poses problems with hygiene in Scheme. I know someone has created something with an extra parameter for the binding name, but it looses it's elegance:
(aif x x-expression
(aif y (f x)
(aif z (f y)
z)))
I've been experimenting with cond When creating evaluators I usually test before I can peel and that ends with if and let nesting. My first iteration looked like:
(define (ev expr env)
(defcond
((symbol? expr) (symbol->value expr env))
((not (pair? expr)) expr => (operator (ev (car expr) env)))
((macro? operator) (macro-apply expr (cdr expr) env) => (args (map (lambda (e) (ev e env)) (cdr expr))))
(else (fun-apply operator args env))))
It also supported an alternative way since I found it not so elegant to reuse =>:
(define (ev expr env)
(defcond
((symbol? expr) (symbol->value expr env))
((not (pair? expr)) expr)
(define operator (ev (car expr) env))
((macro? operator) (macro-apply expr (cdr expr) env))
(define args (map (lambda (e) (ev e env)) (cdr expr)))
(else (fun-apply operator args env))))
Now this can be used in the same way as aif as well. If you're interested the Scheme macro is:
(define-syntax defcond
(syntax-rules (else bind define =>)
((_ "build" terms ())
terms)
((_ "build" alternative ((bind (b e) ...) . rest))
(defcond "build" (let ((b e) ...) alternative) rest))
((_ "build" alternative ((bind name (b e) ...) . rest))
(defcond "build" (let name ((b e) ...) alternative) rest))
((_ "build" alternative ((define b e) . rest))
(defcond "build" (letrec ((b e)) alternative) rest))
((_ "build" alternative ((predicate consequent) . rest))
(defcond "build" (if predicate consequent alternative) rest))
((_ "build" alternative ((predicate consequent => (b e) ...) . rest))
(defcond "build" (if predicate consequent (let ((b e) ...) alternative)) rest))
((_ "build" alternative ((predicate consequent) . rest))
(defcond "build" (if predicate consequent alternative) rest))
((_ "maybe-else" ((else expression) . rest))
(defcond "build" expression rest))
((_ "maybe-else" ((something expression) . rest))
(defcond "build" #f ((something expression) . rest)))
((_ "reverse" terms ())
(defcond "maybe-else" terms))
((_ "reverse" (fterms ...) (term1 terms ...))
(defcond "reverse" (term1 fterms ...) (terms ...)))
((_ terms ...)
(defcond "reverse" () (terms ...)))))
Not very elegant implementation, but it works. As you can see it supports bind and named bind as well. eg.
(defcond
((not (pair? lst)) #f)
(bind loop ((lst lst) (acc 0)))
((null? lst) acc)
(else (loop (cdr lst) (+ acc (car lst))))
While I like the idea I still don't think it is a divine and elegant as it should be. Until a better syntax emerges I'll be writing it for readability. eg.:
(if (not (pair? lst))
#f
(let loop ((lst lst) (acc 0))
(if (null? lst)
acc
(loop (cdr lst) (+ acc (car lst))))))
I'm totally new in Scheme and interpreters. My job is modifying the following code. If I run
(run "sub1(12,2,3,4)")
in Drracket, it returns 11. I need to modify the interpreter so that it behaves correctly for a single numeric argument, but returns 0 otherwise (that is, whenever the number of arguments is different from 1, or the argument is of incompatible type)
I understand different modules of the code, but I'm totally confused how to modify it. It would be great if you can help me or give me a pointer to some similar things.
#lang eopl
;;;;;;;;;;;;;;;; top level and tests ;;;;;;;;;;;;;;;;
(define run
(lambda (string)
(eval-program (scan&parse string))))
;; needed for testing
(define equal-external-reps? equal?)
;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
(define the-lexical-spec
'((whitespace (whitespace) skip)
(comment ("%" (arbno (not #\newline))) skip)
(identifier
(letter (arbno (or letter digit "_" "-" "?")))
symbol)
(number (digit (arbno digit)) number)))
(define the-grammar
'((program (expression) a-program)
(expression (number) lit-exp)
(expression (identifier) var-exp)
(expression
(primitive "(" (separated-list expression ",") ")")
primapp-exp)
(expression
("if" expression "then" expression "else" expression)
if-exp)
(expression
("let" (arbno identifier "=" expression) "in" expression)
let-exp)
(expression
("proc" "(" (separated-list identifier ",") ")" expression)
proc-exp)
(expression
("(" expression (arbno expression) ")")
app-exp)
(expression
("begin" expression (arbno ";" expression) "end")
begin-exp)
(primitive ("+") add-prim)
(primitive ("-") subtract-prim)
(primitive ("*") mult-prim)
(primitive ("add1") incr-prim)
(primitive ("sub1") decr-prim)
(primitive ("zero?") zero-test-prim)
))
(sllgen:make-define-datatypes the-lexical-spec the-grammar)
(define show-the-datatypes
(lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
(define scan&parse
(sllgen:make-string-parser the-lexical-spec the-grammar))
(define just-scan
(sllgen:make-string-scanner the-lexical-spec the-grammar))
;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
(define eval-program
(lambda (pgm)
(cases program pgm
(a-program (body)
(eval-expression body (init-env))))))
(define eval-expression
(lambda (exp env)
(cases expression exp
(lit-exp (datum) datum)
(var-exp (id) (apply-env env id))
(primapp-exp (prim rands)
(let ((args (eval-rands rands env)))
(apply-primitive prim args)))
(if-exp (test-exp true-exp false-exp) ;\new4
(if (true-value? (eval-expression test-exp env))
(eval-expression true-exp env)
(eval-expression false-exp env)))
(begin-exp (exp1 exps)
(let loop ((acc (eval-expression exp1 env))
(exps exps))
(if (null? exps) acc
(loop (eval-expression (car exps) env) (cdr exps)))))
(let-exp (ids rands body) ;\new3
(let ((args (eval-rands rands env)))
(eval-expression body (extend-env ids args env))))
(proc-exp (ids body) (closure ids body env)) ;\new1
(app-exp (rator rands) ;\new7
(let ((proc (eval-expression rator env))
(args (eval-rands rands env)))
(if (procval? proc)
(apply-procval proc args)
(eopl:error 'eval-expression
"Attempt to apply non-procedure ~s" proc))))
;&
(else (eopl:error 'eval-expression "Not here:~s" exp))
)))
;;;; Right now a prefix must appear earlier in the file.
(define eval-rands
(lambda (rands env)
(map (lambda (x) (eval-rand x env)) rands)))
(define eval-rand
(lambda (rand env)
(eval-expression rand env)))
(define apply-primitive
(lambda (prim args)
(cases primitive prim
(add-prim () (+ (car args) (cadr args)))
(subtract-prim () (- (car args) (cadr args)))
(mult-prim () (* (car args) (cadr args)))
(incr-prim () (+ (car args) 1))
(decr-prim () (- (car args) 1))
;&
(zero-test-prim () (if (zero? (car args)) 1 0))
)))
(define init-env
(lambda ()
(extend-env
'(i v x)
'(1 5 10)
(empty-env))))
;;;;;;;;;;;;;;;; booleans ;;;;;;;;;;;;;;;;
(define true-value?
(lambda (x)
(not (zero? x))))
;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
(define-datatype procval procval?
(closure
(ids (list-of symbol?))
(body expression?)
(env environment?)))
(define apply-procval
(lambda (proc args)
(cases procval proc
(closure (ids body env)
(eval-expression body (extend-env ids args env))))))
;;;;;;;;;;;;;;;; environments ;;;;;;;;;;;;;;;;
(define-datatype environment environment?
(empty-env-record)
(extended-env-record
(syms (list-of symbol?))
(vec vector?) ; can use this for anything.
(env environment?))
)
(define empty-env
(lambda ()
(empty-env-record)))
(define extend-env
(lambda (syms vals env)
(extended-env-record syms (list->vector vals) env)))
(define apply-env
(lambda (env sym)
(cases environment env
(empty-env-record ()
(eopl:error 'apply-env "No binding for ~s" sym))
(extended-env-record (syms vals env)
(let ((position (rib-find-position sym syms)))
(if (number? position)
(vector-ref vals position)
(apply-env env sym)))))))
(define rib-find-position
(lambda (sym los)
(list-find-position sym los)))
(define list-find-position
(lambda (sym los)
(list-index (lambda (sym1) (eqv? sym1 sym)) los)))
(define list-index
(lambda (pred ls)
(cond
((null? ls) #f)
((pred (car ls)) 0)
(else (let ((list-index-r (list-index pred (cdr ls))))
(if (number? list-index-r)
(+ list-index-r 1)
#f))))))
(define iota
(lambda (end)
(let loop ((next 0))
(if (>= next end) '()
(cons next (loop (+ 1 next)))))))
(define difference
(lambda (set1 set2)
(cond
((null? set1) '())
((memv (car set1) set2)
(difference (cdr set1) set2))
(else (cons (car set1) (difference (cdr set1) set2))))))
You could change as follows:
(define apply-primitive
[... part of code ...]
(decr-prim () (if (and (= (length args) 1) (number? (car args)))
(- (car args) 1)
0))
[... rest of code ...]
I assume the other primitives should be changed accordingly, this will only change sub1.
I am trying to write an interpreter for scheme. So far i implemented define, if and some arithmetic expressions. Here is the grammar for my interpreter:
<s6> -> <expr>
| <define>
<expr> -> NUMBER
| IDENT
| <if>
| <let>
<define> -> ( define IDENT <expr> )
<if> -> ( if <expr> <expr> <expr> )
<let> -> ( let ( <var_binding_list> ) <expr> )
<var_binding_list> -> ( IDENT <expr> ) <var_binding_list>
| ( IDENT <expr> )
Here is the code i have written so far:
(define get-operator (lambda (op-symbol)
(cond
((equal? op-symbol '+) +)
((equal? op-symbol '-) -)
((equal? op-symbol '*) *)
((equal? op-symbol '/) /)
(else (error "s6-interpret: operator not implemented -->" op-symbol)))))
(define let-stmt? (lambda (e)
(and (list? e) (equal? (car e) 'let) (= (length e) 3))))
(define if-stmt? (lambda (e)
(and (list? e) (equal? (car e) 'if) (= (length e) 4))))
(define define-stmt? (lambda (e)
(and (list? e) (equal? (car e) 'define) (symbol? (cadr e)) (= (length e) 3))))
(define get-value (lambda (var env)
(cond
((null? env) (error "s6-interpret: unbound variable -->" var))
((equal? (caar env) var) (cdar env))
(else (get-value var (cdr env))))))
(define extend-env (lambda (var val old-env)
(cons (cons var val) old-env)))
(define repl (lambda (env)
(let* (
(dummy1 (display "cs305> "))
(expr (read))
(new-env (if (define-stmt? expr)
(extend-env (cadr expr) (s6-interpret (caddr expr) env) env)env))
(val (if (define-stmt? expr)
(cadr expr)
(s6-interpret expr env)))
(dummy2 (display "cs305: "))
(dummy3 (display val))
(dummy4 (newline))
(dummy4 (newline)))
(repl new-env))))
(define s6-interpret (lambda (e env)
(cond
((number? e) e)
((symbol? e) (get-value e env))
((not (list? e)) (error "s6-interpret: cannot evaluate -->" e))
((if-stmt? e) (if (eq? (cadr e) 0) ( s6-interpret (cadddr e) env) ( s6-interpret(caddr e) env)))
((let-stmt? e) (apply let (map s6-interpret (cdr e))))
(else
(let ((operands (map s6-interpret (cdr e) (make-list (length (cdr e)) env)))
(operator (get-operator (car e))))
(apply operator operands))))))
(define cs305-interpreter (lambda () (repl '())))
Everything i have written except "let" works fine. let-stmt? procedure also works as i want but the part of the code ((let-stmt? e) (apply let (map s6-interpret (cdr e)))) in s6-interpret does not work fine, it gives me an error saying that "syntactic keyword may not be used as an expression". Can anyone help me with the implementation of the interpreter for "let" statement as given in the grammar?
Thank you
You can't apply the special form let. The error is clear: it's not a procedure, it's syntax (a macro). One possible solution would be to implement a syntactic transformation at the evaluator level, once a let is detected, transform it into a lambda expression and evaluate it.
Take a look at exercise 4.6 in SICP, look for the topic "Derived Expressions". The key idea here is that if you find an expression such as this one:
(let ((x 1)
(y 2))
(+ x y))
You must transform it into this expression, that can be easily evaluated:
((lambda (x y)
(+ x y))
1 2)
It is easy to implement let without worrying about lambda as let just extends the environment and evaluates the body in the newly extended environment. As so:
...
((let-stmt? e)
(let ((names (map car (cadr e)))
(inits (map cadr (cadr e))))
;; Evaluate inits in env
(let ((vals (map (lambda (init) (s6-interpret init env)) inits)))
;; Extend env with names+vals
(let ((new-env (append (map cons names vals) env)))
;; Eval body in new env
(s6-interpret (caddr e) new-env))))) ; assumes 'body' is one form...
...
You also get to avoid worrying about general function calls using this approach.