I don't understand the purpose of the 1st LET in condlet-clause below.
`(,(car cl) (let ,(mapcar #'cdr vars)
Is this necessary since it does not define specific value here?
It just declare the local variables instead. Why bother to do this?
(defmacro condlet (clauses &body body)
(let ((bodfn (gensym))
(vars (mapcar #'(lambda (v) (cons v (gensym)))
(remove-duplicates
(mapcar #'car
(mappend #'cdr clauses))))))
`(labels ((,bodfn ,(mapcar #'car vars)
,#body))
(cond ,#(mapcar #'(lambda (cl)
(condlet-clause vars cl bodfn))
clauses)))))
(defun condlet-clause (vars cl bodfn)
`(,(car cl) (let ,(mapcar #'cdr vars)
(let ,(condlet-binds vars cl)
(,bodfn ,#(mapcar #'cdr vars))))))
(defun condlet-binds (vars cl)
(mapcar #'(lambda (bindform)
(if (consp bindform)
(cons (cdr (assoc (car bindform) vars))
(cdr bindform))))
(cdr cl)))
Based on this implementation of CONDLET, condlet can be used like this:
(condlet (((= 1 2) (x 1) (y 2))
((= 1 1) (x 2) (y 1))
(t (x 3) (z 3)))
(list x y z))
Notice that there are three variables that appear in the body part, x, y, and z, but each of those clauses only binds two: the first and second bind x and y, and the third binds x and z. By doing
(let (x y z)
(let <bindings from actual clause>
(bodyfn x y z)))
the macro guarantees that x, y, and z all have default values of nil. The <bindings from actual clause> will lexically shadow the variables that the actual clause is responsible for binding. That's a bit of a simplification, though. To see what's actually happening, let's look at the macroexpansion of that example:
(pprint (macroexpand-1 '(condlet (((= 1 2) (x 1) (y 2))
((= 1 1) (x 2) (y 1))
(t (x 3) (z 3)))
(list x y z))))
;=>
(LABELS ((#:G973 (Y X Z) ; g973 = bodfn
(LIST X Y Z)))
(COND
((= 1 2)
(LET (#:G974 #:G975 #:G976) ; y(g974) = nil, x(g975) = nil, z(g976) = nil
(LET ((#:G975 1) (#:G974 2)) ; x = 1, y = 2
(#:G973 #:G974 #:G975 #:G976)))) ; (bodfn y x z)
((= 1 1)
(LET (#:G974 #:G975 #:G976) ; y = nil, x = nil, z = nil
(LET ((#:G975 2) (#:G974 1)) ; x = 2, y = 1
(#:G973 #:G974 #:G975 #:G976)))) ; (bodfn y x z)
(T
(LET (#:G974 #:G975 #:G976) ; y = nil, x = nil, z = nil
(LET ((#:G975 3) (#:G976 3)) ; x = 3, z = 4
(#:G973 #:G974 #:G975 #:G976)))))) ; (bodfn y x z)
Related
I am trying to do the exercises on this tutorial about CLOS using SBCL and Slime (Emacs).
I have this class, instance, and function to set values for the slots:
(defclass point ()
(x y z))
(defvar my-point
(make-instance 'point))
(defun with-slots-set-point-values (point a b c)
(with-slots (x y z) point (setf x a y b z c)))
Using the REPL, it works fine:
CL-USER> (with-slots-set-point-values my-point 111 222 333)
333
CL-USER> (describe my-point)
#<POINT {1003747793}>
[standard-object]
Slots with :INSTANCE allocation:
X = 111
Y = 222
Z = 333
; No value
Now, the exercises indicates that using the symbol-macrolet I need to implement my version of with-slots.
I have a partial implementation of my with-slots (I still need to insert add the operation):
(defun partial-my-with-slots (slot-list object)
(mapcar #'(lambda (alpha beta) (list alpha beta))
slot-list
(mapcar #'(lambda (var) (slot-value object var)) slot-list)))
It works when calling it:
CL-USER> (partial-my-with-slots '(x y z) my-point)
((X 111) (Y 222) (Z 333))
Since this use of symbol-macrolet works:
CL-USER> (symbol-macrolet ((x 111) (y 222) (z 333))
(+ x y z))
666
I tried doing:
CL-USER> (symbol-macrolet (partial-my-with-slots '(x y z) my-point)
(+ x y z))
But, for some reason that I do not know, Slime throws the error:
malformed symbol/expansion pair: PARTIAL-MY-WITH-SLOTS
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
Why does this happen? How can I fix this?
You can't write with-slots as a function which is called at run time. Instead it needs to be a function which takes source code as an argument and returns other source code. In particular if given this argument
(my-with-slots (x ...) <something> <form> ...)
It should return this result:
(let ((<invisible-variable> <something))
(symbol-macrolet ((x (slot-value <invisible-variable>)) ...)
<form> ...))
You need <invisible-variable> so you evaluate <object-form> only once.
Well, here is a function which does most of that:
(defun mws-expander (form)
(destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
(declare (ignore mws))
`(let ((<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value <invisible-variable>
',slot-name)))
slot-names)
,#forms))))
And you can check this:
> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((<invisible-variable> a))
(symbol-macrolet ((x (slot-value <invisible-variable> 'x))
(y (slot-value <invisible-variable> 'y)))
(list x y)))
So that's almost right, except the invisible variable really needs to be invisible:
(defun mws-expander (form)
(destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
(declare (ignore mws))
(let ((<invisible-variable> (gensym)))
`(let ((,<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value ,<invisible-variable>
',slot-name)))
slot-names)
,#forms)))))
And now:
> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((#:g1509 a))
(symbol-macrolet ((x (slot-value #:g1509 'x))
(y (slot-value #:g1509 'y)))
(list x y)))
Well, a function which takes source code as an argument and returns other source code is a macro. So, finally, we need to install this function as a macroexpander, arranging to ignore the second argument that macro functions get:
(setf (macro-function 'mws)
(lambda (form environment)
(declare (ignore environment))
(mws-expander form)))
And now:
> (macroexpand '(mws (x y) a (list x y)))
(let ((#:g1434 a))
(symbol-macrolet ((x (slot-value #:g1434 'x)) (y (slot-value #:g1434 'y)))
(list x y)))
This would be more conventionally written using defmacro, of course:
(defmacro mws ((&rest slot-names) object-form &rest forms)
(let ((<invisible-variable> (gensym)))
`(let ((,<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value ,<invisible-variable> ',slot-name)))
slot-names)
,#forms))))
However the two definitions are equivalent (modulo needing some eval-whenery to make the first work properly with the compiler).
You need to return expressions that will call slot-value when substituted into the macro expansion, rather than calling the function immediately. Backquote is useful for this.
(defun partial-my-with-slots (slot-list object)
(mapcar #'(lambda (alpha beta) (list alpha beta))
slot-list
(mapcar #'(lambda (var) `(slot-value ,object ',var)) slot-list)))
> (partial-my-with-slots '(x y z) 'my-point)
((x (slot-value my-point 'x)) (y (slot-value my-point 'y)) (z (slot-value my-point 'z)))
You use this in your with-slots macro like this:
(defmacro my-with-slots ((&rest slot-names) instance-form &body body)
`(symbol-macrolet ,(partial-my-with-slots slot-names instance-form)
,#body))
> (macroexpand '(my-with-slots (x y z) point (setf x a y b z c)))
(SYMBOL-MACROLET ((X (SLOT-VALUE POINT 'X))
(Y (SLOT-VALUE POINT 'Y))
(Z (SLOT-VALUE POINT 'Z)))
(SETF X A
Y B
Z C))
I am building a program and lisp and need to check if a Cons exist in a list of cons, but for some reason it keep returning nil in the if statement, here is the current code I am using for it.
(defun countVertexTriangles (graph numOfVertices)
(findTriangle graph numOfVertices)
)
(defun findTriangle(graph numOfVertices)
(loop for (x y) in graph do
(loop for z from 1 to numOfVertices do
(write graph)
(terpri)
(write (cons z (cons y nil)))
(terpri)
(write (cons z (cons x nil)))
(terpri)
; (if (AND (member (cons z (cons y nil)) graph) (member (cons z (cons x nil)) graph))
; then (write (cons y z))
; )
)
(terpri)
)
)
; (defun findEdge(graph edge)
; (loop for x in graph do
; (write x)
; (write edge)
; (if (eql x edge)
; (write "A")
; (write "B")
; )
; )
; )
(defun testFunct ()
(setf g1 '((1 2)(2 3)(1 3)(2 4)(3 4)(4 5)(3 5)))
(countVertexTriangles g1 5)
)
(testFunct)
Why does the member(cons z (cons y nil)) return nil even when in the first iteration we can see (1 2) exists in the list?
Edit:
Currently even when it is true it returns nil, why would this be the case given the following code?
(defun countVertexTriangles (graph numOfVertices)
(findTriangle graph numOfVertices)
)
(defun findTriangle(graph numOfVertices)
(loop for (x y) in graph do
(loop for z from 1 to numOfVertices do
; (write graph)
; (terpri)
; (write (list z y ))
; (terpri)
(write (findEdge graph (list z y)))
(terpri)
; (if (AND (member (list z x) graph) (member (list z x ) graph))
; then (write "TEST")
; )
)
(terpri)
)
)
(defun findEdge(graph edge)
(loop for x in graph do
(if (equal x edge)
(return-true)
(return-false)
)
)
)
(defun return-true ()
t)
(defun return-false ()
nil)
(defun testFunct ()
(setf g1 '((1 2)(2 3)(1 3)(2 4)(3 4)(4 5)(3 5)))
(countVertexTriangles g1 5)
)
findEdge doesn't return anything. Calling return-true and return-false doesn't return from findEdge. You also shouldn't return until you find a match.
(defun findEdge(graph edge)
(loop for x in graph do
(if (equal x edge)
(return-from findEdge (return-true))
)
)
(return-false)
)
This can be simplified to just:
(defun findEdge (graph edge)
(member edge findEdge :test #'equal))
I would like to write a macro to create shorthand syntax for hiding more verbose lambda expressions, but I'm struggling to understand how to write macros (which I realize is an argument against using them).
Given this example:
(define alist-example
'((x 1 2 3) (y 4 5 6) (z 7 8 9)))
(define ($ alist name)
(cdr (assoc name alist)))
((lambda (a) (map (lambda (x y z) (+ x y z)) ($ a 'x) ($ a 'y) ($ a 'z))) alist-example)
((lambda (a) (map (lambda (y) (/ y (apply max ($ a 'y)))) ($ a 'y))) alist-example)
I would like to write a macro, with-alist, that would allow me to write the last two expressions similar to this:
(with-alist alist-example (+ x y z))
(with-alist alist-example (/ y (apply max y)))
Any advice or suggestions?
Here is a syntax-rules solution based on the feedback that I received in the other answer and comments:
(define ($ alist name)
(cdr (assoc name alist)))
(define-syntax with-alist
(syntax-rules ()
[(_ alist names expr)
(let ([alist-local alist])
(apply map (lambda names expr)
(map (lambda (name) ($ alist-local name)) (quote names))))]))
Here is some example usage:
> (define alist-example
'((x 1 2 3) (y 4 5 6) (z 7 8 9)))
> (with-alist alist-example (x) (+ x 2))
(3 4 5)
> (with-alist alist-example (x y) (+ x y))
(5 7 9)
> (with-alist alist-example (x y z) (+ x y z))
(12 15 18)
This answer stops short of solving the more complicated example, (with-alist alist-example (/ y (apply max y))), in my question, but I think this is a reasonable approach for my purposes:
> (with-alist alist-example (y) (/ y (apply max ($ alist-example 'y))))
(2/3 5/6 1)
EDIT: After some additional tinkering, I arrived at a slightly different solution that I think will provide more flexibility.
My new macro, npl, expands shorthand expressions into a list of names and procedures.
(define-syntax npl
(syntax-rules ()
[(_ (names expr) ...)
(list
(list (quote names) ...)
(list (lambda names expr) ...))]))
The output of this macro is passed to a regular procedure, with-list-map, that contains most the core functionality in the with-alist macro above.
(define (with-alist-map alist names-proc-list)
(let ([names-list (car names-proc-list)]
[proc-list (cadr names-proc-list)])
(map (lambda (names proc)
(apply map proc
(map (lambda (name) ($ alist name)) names)))
names-list proc-list)))
The 3 examples of with-alist usage above can be captured in a single call to with-alist-map.
> (with-alist-map alist-example
(npl ((x) (+ x 2))
((x y) (+ x y))
((x y z) (+ x y z))))
((3 4 5) (5 7 9) (12 15 18))
The immediate problem I see is that there is no way to tell which bindings to pick. Eg. is apply one of the elements in the alist or is it a global variable? That depends. I suggest you do:
(with-alist ((x y z) '((x 1 2 3) (y 4 5 6) (z 7 8 9)))
(+ x y z))
(let ((z 10))
(with-alist ((x y) alist-example)
(+ x y z)))
And that it should translate to:
(let ((tmp '((x 1 2 3) (y 4 5 6) (z 7 8 9))))
(apply map (lambda (x y z) (+ x y z))
(map (lambda (name) ($ tmp name)) '(x y z))))
(let ((z 10))
(let ((tmp alist-example))
(apply map (lambda (x y) (+ x y z))
(map (lambda (name) ($ tmp name)) '(x y)))))
This is then straight forward to do with syntax-rules. Eg. make a pattern and write the replacement. Good luck.
This is my first time working with racket, and I am getting an error message (*: unbound identifier;) when trying to evaluate a list in Dr. Racket.
#lang racket
(define (randop)
(define x(random 3))
(cond
((= x 0) '+)
((= x 1) '-)
((= x 2) '*)
)
)
(define (randexp ht)
(define x(random 10))
(define y(random 10))
(define z(randop))
(eval (list z y x))
)
(randexp 1)
When executing racket in the console, (eval lst) works fine, though when I execute this code, it comes up with an unbound identifier. Any help is appreciated.
You don't need eval here. Instead of returning the symbols return the procedures instead:
#lang racket
(define (randop)
(define x (random 3))
(cond ((= x 0) +) ; + not quoted means if will return what + evaluates to
((= x 1) -) ; which is the procedures they represent
((= x 2) *)))
(define (randexp)
(define x (random 10))
(define y (random 10))
(define z (randop))
(z y x))) ; call z (the procedure returned by randop) with arguments x and y.
(randexp)
There's a problem with the way you're calling eval, in Racket you have to do this in a file:
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(define (randop)
(define x (random 3))
(cond
((= x 0) '+)
((= x 1) '-)
((= x 2) '*)))
(define (randexp ht)
(define x (random 10))
(define y (random 10))
(define z (randop))
(eval (list z y x) ns))
(randexp 1)
Also, you're not actually using the ht parameter, consider deleting it.
I am writing a lisp function and I keep getting EVAL - undefined function x when I try to return the value of x from the function.
(defun p+ (x y)
(recurcollect (gluelist x y) '()))
(defun isinlist (x y)
(if (car y)
(if (equal (cdr x) (cdar y))
t
(if (cdr y)
(isinlist(x (cdr y)))
NIL))
NIL))
(defun collectvalue (x y) ;takes an expression and a list and returns the sum of all like expressions from the list
(if (equal x NIL)
(print '(x is NIL))
(if (equal (cdr x) (cdar y))
(if (cdr y)
(collectvalue (list (+ (car x) (caar y)) (cdr x)) (cdr y))
(list (+ (car x) (caar y)) (cdr x)))
(if (cdr y)
(collectvalue x (cdr y))
x))))
(defun recurcollect (x y) ;returns a flat list of collected expressions
(if (isinlist (car x) y)
(recurcollect (cdr x) y)
(if (cdr x)
(recurcollect x (cons y (collectvalue (car x) (cdr x))))
(cons y (car x)))))
(defun gluelist (x y)
(if (cdr x)
(cons (car x) (gluelist (cdr x) y))
(cons (car x) y)))
(print (p+ '(2 0 1) '(4 0 1))) ;(6 0 1)
I believe the error is caused by the x at the end of the function but I cant see why, as far as I can tell my brackets are correctly paired up and I cant see why it is trying to evaluate x as a function.
The problem is in isinlist which is called recursively as (isinlist(x (cdr y))).
(x ...) is interpreted as a function call of function x.
You probably want (isinlist x (cdr y)) instead.
Incidentally, you can replace isinlist with member (with :key #'cdr :test #'equal).