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.
Related
I have code which is inserting new word on the right side of choosen word
(define insertR
(lambda (new old lst)
(cond
((null? lst) (lst))
(else (cond
((eq? (car lst) old)
(cons old
(cons new (cdr lst))))
(else (cons (car lst)
(insertR new old
(cdr lst)))))))))
i need to make it insert that word beside first appearance of word starting from the end of list. Tried to work with reverse but could not get that to work.
There are two strategies you can take to add it next to the last occurence.
The first is to use a helper and start off with the reverse list. This is very simple and my preferred solution.
(define (insert-by-last-match insert find lst)
(let loop ((lst (reverse lst)) (acc '()))
(if (null? lst)
acc
(let ((a (car lst)))
(if (equal? a find)
(append (reverse (cdr lst))
(list* find insert acc))
(loop (cdr lst) (cons a acc)))))))
The other one is kind of obscure. Whenever you find the element you replace last-match with a callback that replaces the computation since it was made and until it gets called with the replacement and the rest of the list, which of course is the correct result. The work done until the end of the list is simply discarded since it is not used, but we do it since we are not sure if we are going to find a later one and then all the work uptil that is of course included in the result.
(define (insert-by-last-match insert find lst)
(define (helper lst last-match)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)))
(cons a
(if (equal? a find)
(let/cc k
(helper d (lambda () (k (cons insert d)))))
(helper d last-match))))))
(helper lst (lambda () lst)))
call/cc (or its variant let/cc) is often described as time travel or advanced goto. It is not very intuitive. Here is a CPS version:
(define (insert-by-last-match insert find lst)
(define (helper lst last-match k)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)) (k2 (lambda (v) (k (cons a v)))))
(if (equal? a find)
(helper d (lambda () (k2 (cons insert d))) k2)
(helper d last-match k2)))))
(helper lst (lambda () lst) (lambda (v) v)))
Basically this is the same as the previous only that here I have written the CPS code and with the let/cc version the implementation does it for me and I get to use k exactly where I need it. In this version you see there is no magic or time travel but the execution that should happen later is simply replaced at a point.
Write in a similar way insertL and apply it to the reversed list.
And reverse the result. Then you will have an insertion beside first appearance of word starting from the end of list
(define insertL
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons new lst))
(else (cons (car lst) (insertL new old (cdr lst)))))))
(define last-insertR
(lambda (new old lst)
(let* ((rlst (reverse lst))
(result (insertL new old rlst)))
(reverse result))))
test:
(last-insertR 'aa 'a '(b c d a h i a g))
;; '(b c d a h i a aa g)
By the way, the beauty of cond is that you can put the conditions always at the beginning - listed one under the other.
So one can write your insertR nicer as:
(define insertR
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons old (cons new (cdr lst))))
(else (cons (car lst) (insertR new old (cdr lst)))))))
I'm working through the Little Schemer and I'm trying to convert all of the answers into Common Lisp.
In chapter 8, anonymous functions are discussed, as well as returning anonymous functions.
For example:
(define insertL-f
(lambda (test?)
(lambda (new old l)
(cond
((null? l) (quote ()))
((test? (car l) old) (cons new l)))
(else (cons (car l) ((insertL-f test?) new old (cdr l))))))))
My code:
(defun insertL-f (test)
(lambda (new old l)
(cond
((null l) '())
((funcall test (car l) old) (cons new l))
(t (cons (car l) (insertL-f test) new old (cdr l))))))
The problem is the last line of the second block of code. I get the error "too many arguments for cons" but I can't add an extra pair of parentheses like the Scheme code does. Is this style of recursion just not possible in Common Lisp?
(defun insertL-f (test)
(lambda (new old l)
(cond
((null l) '())
((funcall test (car l) old) (cons new l))
(t (cons (car l)
(funcall (insertL-f test)
new
old
(cdr l)))))))
insertL-f returns a function and in your Scheme version you apply it while in CL have flattened the list instead if applying it with funcall However it seems like the function that is to be returned is equal to the one it fetches so you can cache it by defining it locally with labels:
(defun insert-l-f (test)
(labels ((func (new old l)
(cond
((null l) '())
((funcall test (car l) old) (cons new l))
(t (cons (car l) (func new old (cdr l)))))))
#'func))
The same in Scheme using local define (which really is aletrec with flatter syntax):
(define (insert-l-f test?)
(define (func new old l)
(cond
((null? l) (quote ()))
((test? (car l) old) (cons new l)))
(else (cons (car l) (func new old (cdr l)))))
func)
(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))
This code replaces first person words with second person words and vice versa. However, it goes through each pair for each word in the phrase, so sometimes it will change back.
Here is the code:
(define (replace pattern replacement lst replacement-pairs)
(cond ((null? lst) '())
((equal? (car lst) pattern)
(cons replacement
(many-replace (cdr replacement-pairs) (cdr lst))))
(else (cons (car lst)
(many-replace (cdr replacement-pairs) (cdr lst))))))
(define (many-replace replacement-pairs lst)
(cond ((null? replacement-pairs) lst)
(else (let ((pat-rep (car replacement-pairs)))
(replace (car pat-rep)
(cadr pat-rep)
(many-replace (cdr replacement-pairs)
lst) replacement-pairs)))))
(define (change-person phrase)
(many-replace '((i you) (me you) (am are) (my your) (are am) (you i) (your my))
phrase))
For example if I entered
(change-person '(you are not being very helpful to me))
it would change you to i but then back to you. How do I fix this?
The procedures replace and many-replace are overly complicated, and the mutual recursion is not doing what you think. If we simplify those procedures and make sure that only a single pass is performed over the input list, we can get a correct answer:
(define (replace replacement-pairs pattern)
(cond ((null? replacement-pairs)
pattern)
((equal? (caar replacement-pairs) pattern)
(cadar replacement-pairs))
(else
(replace (cdr replacement-pairs) pattern))))
(define (many-replace replacement-pairs lst)
(if (null? lst)
'()
(cons (replace replacement-pairs (car lst))
(many-replace replacement-pairs (cdr lst)))))
The keen eye will notice that the previous procedures can be expressed in a succinct way by using some higher-order procedures. A more idiomatic solution could look like this:
(define (replace replacement-pairs pattern)
(cond ((assoc pattern replacement-pairs) => cadr)
(else pattern)))
(define (many-replace replacement-pairs lst)
(map (curry replace replacement-pairs) lst))
Either way, it works as expected:
(change-person '(you are not being very helpful to me))
=> '(i am not being very helpful to you)
I've written a slightly easier solution:
(define (many-replace pattern phrase)
(let loop ((phrase phrase) (result '()))
(if (empty? phrase) (reverse result)
(let* ((c (car phrase)) (a (assoc c pattern)))
(if a
(loop (cdr phrase) (cons (cadr a) result))
(loop (cdr phrase) (cons c result)))))))
(change-person '(you are not being very helpful to me))
=> '(i am not being very helpful to you)
As I learn scheme and racket I find myself repeating this pattern again and again. Where I have a recursive function where some of the parameters to the function change but some of the parameters do not. I build an outer function that takes all the parameters and within that define an inner function that takes only the changing parameters and recur on that.
As a concrete example heres a case based somewhat on a function exercise in "The Little Schemer"
;inserts an item to the right of an element in a list
(define (insert-to-right new old lat)
(define (insert-to-right lat)
(cond
[(null? lat) lat]
[(eq? old (car lat) ) (cons old (cons new (cdr lat)))]
[else (cons (car lat) (insert-to-right (cdr lat)))]))
(insert-to-right lat))
Is it possible to build a macro define* and an operator (for example a vertical bar) such that I would type:
(define* (insert-to-right new old | lat)
(cond
[(null? lat) lat]
[(eq? old (car lat) ) (cons old (cons new (cdr lat)))]
[else (cons (car lat) (insert-to-right (cdr lat)))]))
and this would then expand into the first form with all the parameters being passed to the outer function but only the parameters after the vertical bar being passed to the inner loop.
You could write such a macro, but you could also just use named let:
(define (insert-to-right new old lat)
(let loop ([lat lat])
(cond
[(null? lat) lat]
[(eq? old (car lat)) (cons old (cons new (cdr lat)))]
[else (cons (car lat) (loop (cdr lat)))])))
After playing around I've built a macro that does what I want.
(define-syntax-rule
(define* (function-name (outer-var ...) (inner-var ...)) expr ...)
(define (function-name outer-var ... inner-var ...)
(define (function-name inner-var ...)expr ...)
(function-name inner-var ...)))
(define* (insert-to-right [new old] [lat])
(cond
[(null? lat) lat]
[(eq? old (car lat) ) (cons old (cons new (cdr lat)))]
[else (cons (car lat) (insert-to-right (cdr lat)))]))
> (insert-to-right 11 3 '(1 2 3 4 5 6))
'(1 2 3 11 4 5 6)
In the define* statement it doesn't use a separator between the inner and outer parameters (as I originally tried to do) but puts the inner and outer parameters in the define* statement into separate lists which I think is more idiomatic Scheme/Racket.
You should not use macros to do this. This is a textbook case for higher-order functions; in particular, I believe your example can be written with pair-fold-right from SRFI-1. Untested code (I hope this is right):
(define (insert-to-right new old lat)
(pair-fold-right (lambda (pair rest)
(if (eq? (car pair) old)
(cons (car pair)
(cons new rest))
pair))
'()
lat))
;;; Example implementation of pair-fold-right, just for one list—your Scheme system
;;; probably has this as a library function somewhere
(define (pair-fold-right fn init list)
(if (null? list)
init
(fn list (pair-fold-right fn init (cdr list)))))