(define (make-frame var val)
(cons var val))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
(set-car! frame (cons var (car frame)))
(set-cdr! frame (cons val (cdr frame))))
(define (empty-env? env)
(null? env))
(define (env-variables env)
(define (merge x)
(if (null? x)
'()
(append (car x) (merge (cdr x)))))
(merge (map frame-variables env)))
(define (env-values env)
(define (merge x)
(if (null? x)
'()
(append (car x) (merge (cdr x)))))
(merge (map frame-values env)))
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())
(define (lookup-variable-value var env)
(define (lookup variables values)
(if (null? variables)
(error "Unbound variable" var)
(if (eq? var (car variables))
(car values)
(lookup (cdr variables) (cdr values)))))
(lookup (env-variables env) (env-values env)))
(define (set-variable-value! var val env)
(define (lookup-set! variables vals)
(if (null? variables)
(error "Sorry Unbound variable -- SET!" var)
(if (eq? var (car variables))
(set-car! vals val)
(lookup-set! (cdr variables) (cdr vals)))))
(lookup-set! (env-variables env) (env-values env))
'ok)
(define test-env
(list (cons (list 'x 'y 'z) (list 1 2 3))
(cons (list 'a 'b 'c) (list 4 5 6))
(cons (list 'm 'n 'q) (list 7 8 9))))
The lookup procedure works well, but the set procedure can't change the val of the var.So here we are.
Scheme is call-by-value, so i doubt that the return value of merge doesn't share object with env. But i don't understand why it don't share.
append shares,map shares,cons shares,(i mean (define y (cons x x)) then you (set-car! x ...) the y will also change) but why doesn't a defined function share?
So i just want to get all of the vars and vals of env (i mean strip off the frame),then search or set them. But i stuck here.
(define x '(a b c))
(define (y z) (set-car! z 'change))
(y x) => (change b c)
This works,so it means the z is replaced by a pointer to x or the return value of merge is a copy of the "old",identical but independent?
When the formal parameter of merge(or others) is replaced by a list,is it a pointer to the list?
How does call-by-value works here?
How can I achieve my idea?
You use env-values and env-variables which effectively appends the frames together into one list. It does this by copying each element to a new list. Your set-car! alters a cons in that new list and does not change the original env.
You should make lookup iterate the original frames and variables and perhaps return the pair which holds the value. If not found you throw an error like (error "Unbound variable" var).
That way lookup-variable-value would become
(define (lookup-variable-value var env)
(car (lookup var env)))
And set-variable-value! would become:
(define (set-variable-value! var val env)
(set-car! (lookup var env) val))
Related
Using a Scheme-like language, I am converting
(quote (lambda (a b) (* a b) (+ a b))))
to:
(quote (lambda (a) (lambda (b) (+ a b) (* a b))))
but with my current implementation I am getting an extra pair of parenthesis around the expressions (+ a b) and (* a b):
(lambda (a) (lambda (b) ((+ a b) (* a b))))
I have spent a lot of time trying to fix this problem, but can't figure it out. I feel like the fix should be trivial.
Here is my code currently:
(define (conv lyst)
(define (helper args)
(cond
((null? args) (append (cddr lyst) args))
(else (cons (car lyst)
(cons (list (car args))
(list (helper (cdr args))))))))
(cond
((eq? 1 (length (car (cdr lyst)))) lyst)
(else (helper (car (cdr lyst))))))
I think your implementation can be simplified. This should work:
(define (conv lyst)
(define (helper args)
(if (null? (cdr args))
(cons 'lambda
(append (list (list (car args)))
(cddr lyst)))
(list 'lambda
(list (car args))
(helper (cdr args)))))
(helper (cadr lyst)))
Or even simpler, using quasiquoting and splicing:
(define (conv lyst)
(define (helper args)
(if (null? (cdr args))
`(lambda (,(car args)) ,#(cddr lyst))
`(lambda (,(car args)) ,(helper (cdr args)))))
(helper (cadr lyst)))
Either way, it works as expected:
(conv '(lambda (a b) (* a b) (+ a b)))
=> '(lambda (a) (lambda (b) (* a b) (+ a b)))
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 need to write a scheme function that returns as a function which then takes another argument, eg a list and in turn return the desired result. In this example (c?r "arg") would return -- (car(cdr -- which then subsequently takes the list argument to return 2
> ((c?r "ar") '(1 2 3 4))
2
> ((c?r "ara") '((1 2) 3 4))
2
The problem I have is how can I return a function that accepts another arg in petite?
Here's how you might write such a function:
(define (c?r cmds)
(lambda (lst)
(let recur ((cmds (string->list cmds)))
(if (null? cmds)
lst
(case (car cmds)
((#\a) (car (recur (cdr cmds))))
((#\d) (cdr (recur (cdr cmds))))
(else (recur (cdr cmds))))))))
Note that I'm using d to signify cdr, not r (which makes no sense, to me). You can also write this more succinctly using string-fold-right (requires SRFI 13):
(define (c?r cmds)
(lambda (lst)
(string-fold-right (lambda (cmd x)
(case cmd
((#\a) (car x))
((#\d) (cdr x))
(else x)))
lst cmds)))
Just wanted to add my playing with this. Uses SRFI-1.
(import (rnrs)
(only (srfi :1) fold)) ;; require fold from SRFI-1
(define (c?r str)
(define ops (reverse (string->list str)))
(lambda (lst)
(fold (lambda (x acc)
((if (eq? x #\a) car cdr) ; choose car or cdr for application
acc))
lst
ops)))
Its very similar to Chris' version (more the previous fold-right) but I do the reverseso i can use fold in the returned procedure. I choose which of car or cdr to call by looking at the character.
EDIT
Here is an alternative version with much more preprocessing. It uses tail-ref and list-tail as shortcuts when there are runs of #\d's.
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (reverse
(if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs)))))
(lambda (lst)
(fold (lambda (fun lst)
(fun lst))
lst
funs))))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
This can be made even simpler in #!racket. we skip the reverse and just do (apply compose1 funs).
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs))))
(apply compose1 funs)))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
Assuming a compose procedure:
(define (compose funs . args)
(if (null? funs)
(apply values args)
(compose (cdr funs) (apply (car funs) args))))
(compose (list cdr car) '(1 2 3 4))
=> 2
c?r can be defined in terms of compose like so:
(define (c?r funs)
(lambda (e)
(compose
(map
(lambda (f) (if (char=? f #\a) car cdr))
(reverse (string->list funs)))
e)))
then
((c?r "ar") '(1 2 3 4))
=> 2
((c?r "ara") '((1 2) 3 4))
=> 2
I'm trying to manipulate the Scheme evaluator and write a make-unbound! procedure that unbinds a variable from the environment:
(define (make-unbound! var env)
(let ((frame (first-frame env)))
(define (scan vars vals)
(let ((new-frame
(make-frame
(zip
(filter (lambda (x) (not (eq? x (car vars)))) vars)
(filter (lambda (x) (not (eq? x (car vals)))) vals))
env)))
(cond ((null? vars)
(display '(No frame to unbind)))
((eq? var (car vars))
(set-car! vars new-frame)) ; the problem seems to be here
(else (scan (cdr vars) (cdr vals))))))
(scan (frame-variables frame)
(frame-values frame))))
The problem seems to be with where I'm setting the car of the variable. But I'm not sure what it should be changing to....
This looks like exercise 4.13 of SICP. The make-unbound! special form can be evaluated like this using Racket:
(define (remove-association! key lst)
(define (loop prev l)
(cond ((null? l) lst)
((equal? (mcar (mcar l)) key)
(set-mcdr! prev (mcdr l))
lst)
(else (loop l (mcdr l)))))
(cond ((null? lst) '())
((eq? (mcar (mcar lst)) key) (mcdr lst))
(else (loop lst (mcdr lst)))))
(define (unbind-variable! var env)
(define (env-loop env)
(define (scan bindings)
(cond ((massq var bindings)
(set-mcar! env (remove-association! var bindings)))
(else (env-loop (enclosing-environment env)))))
(unless (eq? env the-empty-environment)
(scan (first-frame env))))
(env-loop env))
(define (unbound-variable exp)
(cadr exp))
(define (eval-make-unbound! exp env)
(unbind-variable! (unbound-variable exp)
env))
It removes the first binding that finds with the given symbol, be it in the current frame or any of its enclosing environments. If the symbol was unbound in the first place, it does nothing. I chose to implement the unbind operation in this fashion so that the (possible) bindings in enclosing environments are kept intact.
Don't forget to specify in the eval procedure that the special form make-unbound! is to be evaluated using the eval-make-unbound procedure.
Also, be warned that I made my implementation using Racket's mutable pairs library, so the procedure names I'm using sometimes have an extra m somewhere in their names, meaning: they're defined for mutable pairs. For example: mcar, mcdr, set-mcar!, set-mcdr!, massq. If any of the previous procedures is not found, simply remove the m from the name and try again.
(define filter-in
(lambda (predicate list)
(let((f
(lambda (l)
(filter-in-sexpr predicate l))))
(map f list))))
(define filter-in-aux
(lambda (pred lst)
(if (null? lst) '()
(cons (filter-in-sexpr pred (car lst))
(filter-in-aux pred (cdr lst))))))
(define filter-in-sexpr
(lambda (pred sexpr)
(if (equal? (pred sexpr) #t)
sexpr
'())))
Calling (filter-in number? ’(a 2 (1 3) b 7)) produces ( () 2 () () 7).
How I can skip null elements from the generated list to get final outcome of (2 7) ?
The problem is that you're mapping filter-in-sxpr over the list. You can either run another filter pass to remove the nulls, or use a modified filter-in-aux like this:
(define filter-in-aux
(lambda (pred lst)
(if (null? lst) '()
(let ((h (filter-in-sexpr pred (car lst)))
(t (filter-in-aux pred (cdr lst))))
(if (null? h) t
(cons h t))))))