Given the following definition of the LISP eval function - what is required to add the defmacro function? (Or even just evaluate a macro)
(defun null. (x)
(eq x '()))
(defun and. (x y)
(cond (x (cond (y 't) ('t '())))
('t '())))
(defun not. (x)
(cond (x '())
('t 't)))
(defun append. (x y)
(cond ((null. x) y)
('t (cons (car x) (append. (cdr x) y)))))
(defun list. (x y)
(cons x (cons y '())))
(defun pair. (x y)
(cond ((and. (null. x) (null. y)) '())
((and. (not. (atom x)) (not. (atom y)))
(cons (list. (car x) (car y))
(pair. (cdr x) (cdr y))))))
(defun assoc. (x y)
(cond ((eq (caar y) x) (cadar y))
('t (assoc. x (cdr y)))))
(defun eval. (e a)
(cond
((atom e) (assoc. e a))
((atom (car e))
(cond
((eq (car e) 'quote) (cadr e))
((eq (car e) 'atom) (atom (eval. (cadr e) a)))
((eq (car e) 'eq) (eq (eval. (cadr e) a)
(eval. (caddr e) a)))
((eq (car e) 'car) (car (eval. (cadr e) a)))
((eq (car e) 'cdr) (cdr (eval. (cadr e) a)))
((eq (car e) 'cons) (cons (eval. (cadr e) a)
(eval. (caddr e) a)))
((eq (car e) 'cond) (evcon. (cdr e) a))
('t (eval. (cons (assoc. (car e) a)
(cdr e))
a))))
((eq (caar e) 'label)
(eval. (cons (caddar e) (cdr e))
(cons (list. (cadar e) (car e)) a)))
((eq (caar e) 'lambda)
(eval. (caddar e)
(append. (pair. (cadar e) (evlis. (cdr e) a))
a)))))
(defun evcon. (c a)
(cond ((eval. (caar c) a)
(eval. (cadar c) a))
('t (evcon. (cdr c) a))))
(defun evlis. (m a)
(cond ((null. m) '())
('t (cons (eval. (car m) a)
(evlis. (cdr m) a)))))
(eval '(car '(a a)) )
The representation of an anonymous macro is by convention a list of the form (macro lambda ...). Try evaling these in your favorite Lisp interpreter (tested in Emacs):
> (defmacro triple (x) `(+ ,x ,x ,x))
triple
> (symbol-function 'triple)
(macro lambda (x) (\` (+ (\, x) (\, x) (\, x))))
Although things don't work that way in Emacs, the only thing left to do is to give the adequate semantics to such a form. That is, when eval. sees ((macro lambda (x) EXPR) FORM), it must
Replace every occurence of x in FORM with EXPR without evaluating EXPR first (as opposed to what happens in a function call);
eval. the result of above.
You can achieve this by adding a clause to the outermost cond in eval. that deals with the ((macro lambda ...) ...) case. Here is a crude prototype:
((eq (caar e) 'macro)
(cond
((eq (cadar e) 'lambda)
(eval. (eval. (car (cdddar e))
(cons (list. (car (caddar e)) (cadr e)) a))
a))))
This code only works for single-argument macros. Fixing that involves writing an auxiliary function substlis. that works like evlis. but without looping to eval.; that is left as an exercise to the reader :-)
To test, define cadr. as a macro thusly:
(defmacro cadr. (x)
(list. 'car (list. 'cdr x)))
After this you would have
> (symbol-function 'cadr.)
(macro lambda (x) (list. (quote car) (list. (quote cdr) x)))
You can construct a form that applies this (macro lambda ...) to an expression, and eval that construction within a context that contains a definition for list. (because it is not considered primitive by the eval. interpreter). For instance,
(let ((e '((macro lambda (x) (list (quote car) (list (quote cdr) x)))
(cons (quote x) (cons (quote y) nil))))
(bindings `((list ,(symbol-function 'list.)))))
(eval. e bindings))
y
Tada!
This is also quite good:
https://web.archive.org/web/20120702032624/http://jlongster.com/2012/02/18/its-not-about-macros-its-about-read.html
"You can implement a macro system in 30 lines of Lisp. All you need is read, and it's easy."
https://gist.github.com/1712455
Related
So for a college assignment we've been asked to work with macros and I'm finding it hard to understand how to implement code in scheme (we went from reversing a string to building an interpreter in one lecture).
(define macro-alist
`((and ,(λ (e)
(let ((forms (cdr e)))
(cond ((null? forms) '#t)
((null? (cdr forms)) (car forms))
(else `(if ,(car forms) (and ,#(cdr forms)) #f))))))
;(or ,error)
;(let ,error)
;(cond ,error)
(if ,(λ (e) (let ((guard (cadr e))
(then-part (caddr e))
(else-part (cadddr e)))
`((%if ,guard (λ () ,then-part) (λ () ,else-part))))))
))
We were asked to 'fill in the error holds in macro-alist' for the weekend and I'm finding it difficult.
I found some resources and combining them with my own brief knowledge I have :
`((or ,(lambda (e)
(and (list-strictly-longer-than? e 0)
(equal? (list-ref e 0) 'or)
(letrec ([visit (lambda (i)
(if(null? i)
#t
(and (is-exression? (car i))
(visit (cdr i)))))])
(visit (cdr e)))))))
`((let ,(lambda (e)
(and (proper-list-of-given-length? e 3)
(equal? (car e) 'let)
(list? (cadr e))
(is-expression? (list-ref e 2))
(lectrec ([visit (trace-lambda visit (i a)
(if(null? i)
#t
(and (proper-list-of-given-length? (car i) 2)
(is-identifier? (caar i))
(is-expression? (cadar i))
(not (member (caar i) a))
(visit (cdr i) (cons (caar i) a)))))])
(visit (cadr e) '()))))))
`((cond ,(lambda (e)
(and (list-strictly-longer-than? e 1)
(equal? (car v) 'cond)
(lectrec ([visit (lambda (i)
(if (null? (cdr i))
(is-else-clause? (car i))
(if (pair? (cdr i))
(and (cond? (car i))
(visit (cdr i))))))])
(visit (cdr e)))))))
For or, let and cond. I'm wondering if these are correct or if I'm close. I don't understand much about macros or scheme in general so some information/help on what to do would be appreciated.
If you look at the implementation of and:
(define expand-and
(λ (e)
(let ((forms (cdr e)))
(cond ((null? forms) '#t)
((null? (cdr forms)) (car forms))
(else `(if ,(car forms) (and ,#(cdr forms)) #f))))))
(expand-and '(and)) ; ==> #t
(expand-and '(and a)) ; ==> a
(expand-and '(and a b)) ; ==> (if a (and b) #f)
I notice two things. It doesn't really double check that the first element is and or if it's a list. Perhaps the interpreter doesn't use this unless it has checked this already?
Secondly it doesn't seem like you need to expand everything. As you see you might end up with some code + and with fewer arguments. No need for recursion since the evaluator will do that for you.
I think you are overthinking it. For or it should be very similar:
(expand-or '(or)) ; ==> #f
(expand-and '(or a b c)) ; ==> (let ((unique-var a)) (if unique-var unique-var (or b c)))
The let binding prevents double evaluation of a but if you have no side effects you might just rewrite it to (if a a (or b)). As with and or might expand to use or with fewer arguments than the original. This trick you can do with cond as well:
(cond (a b c)
...) ; ==>
(if a
(begin b c)
(cond ...))
let does not need this since it's perhaps the simplest one if you grasp map:
(let ((a x) (c y))
body ...) ; ==>
((lambda (a c) body ...) x y)
The report has examples of how the macros for these are made, but they might not be the simplest to rewrite to functions that takes code as structure like your interpeter. However using the report to understand the forms would perhaps worked just as well as posting a question here on SO.
How could I prevent the the double recursive call to (f (car l)) without using set/setq/setf ?
(defun f(l)
(cond
((null l) nil)
((listp (car l)) (append (f (car l)) (f (cdr l)) (car (f (car l)))))
(T (list (car l)))
)
)
You think the following solves it?
(defun f(l)
(cond
((null l) nil)
((listp (car l))
(funcall #'(lambda(ff) (append ff (f (cdr l)) (list (car ff)))) (f (car l))))
(T (list (car l)))
)
)
Your attempt is okay, but is usually written as:
...
(bar (foo abcde))
...
(baz (foo abcde))
...
->
(let ((r (foo abcde)))
...
(bar r)
...
(baz r)
...)
also note:
(funcall #'(lambda (foo) ...) bar)
can be written in Common Lisp as:
((lambda (foo) ...) bar)
or preferred, as already mentioned, as:
(let ((foo bar))
...)
This is my function that's supposed to implement infix evaluation for * and + operations.
(defun calculate(l)
(cond
((eql (cadr l) '+) (+ (car l) (cddr l)))
((eql (cadr l) '*) (- (car l) (cddr l)))
)
)
When I run this with the list '(3 + 4) it gives me an error saying "(4) is not a number". Any ideas what the problem might be?
Symbols can be called as functions. Thus your code is just this:
(defun calculate (l)
(funcall (second l) (first l) (third l)))
or
(defun calculate (l)
(destructuring-bind (arg1 op arg2)
l
(funcall op arg1 arg2)))
Example:
CL-USER 77 > (calculate '(20 + 30))
50
The part with (cddr l) should be (caddr l). You have to access the first element of the list, not the list. The code should be then:
(defun calculate(l)
(cond
((eql (cadr l) '+) (+ (car l) (caddr l)))
((eql (cadr l) '*) (- (car l) (caddr l)))
)
)
(defun rep(list)
(format t"~a~%" list)
(cond
((null list) nil)
((atom (car list)) (cons (car list) (rep (cdr list))))
((listp (car list)) (cons (car (reverse (car list))) (cdr list)))
(t (rep list))
)
)
Write a function to replace each sublist of a list with its last element.
A sublist is an element from the first level, which is a list.
Example:
(a (b c) (d (e (f)))) ==> (a c (e (f))) ==> (a c (f)) ==> (a c f)
(a (b c) (d ((e) f))) ==> (a c ((e) f)) ==> (a c f)
I have the above problem to solve. Got it till one point but I'm stuck.
Apparently it doesn't go to the next elements in the list and I don't know why. Any ideas?
I would break it down like this:
(defun last-element (lst)
(if (listp lst)
(last-element (car (last lst)))
lst))
(defun rep (lst)
(when lst
(cons (last-element (car lst)) (rep (cdr lst)))))
then
(rep '(a (b c) (d (e (f)))))
=> '(A C F)
Did it without using map functions
(defun rep(list)
(cond
((null list) nil)
((listp (car list)) (rep (cons (car (reverse (car list))) (rep (cdr list)))))
(t (cons (car list) (rep (cdr list))))
)
)
Need to write a union function in lisp that takes two lists as arguments and returns a list that is the union of the two with no repeats. Order should be consistent with those of the input lists
For example: if inputs are '(a b c) and '(e c d) the result should be '(a b c e d)
Here is what I have so far
(defun stable-union (x y)
(cond
((null x) y)
((null y) x))
(do ((i y (cdr i))
(lst3 x (append lst3
(cond
((listp i)
((null (member (car i) lst3)) (cons (car i) nil) nil))
(t (null (member i lst3)) (cons i nil) nil)))))
((null (cdr i)) lst3)))
My error is that there is an "illegal function object" with the segment (null (member (car i) lst3))
Advice?
You've got your parens all jumbled-up:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x) ) END OF COND form - has no effect
(do ((i y (cdr i))
^^
(lst3 x (append lst3
(cond
((listp i)
( (null (member (car i) lst3))
^^ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ called as a function
(cons (car i) nil) with two arguments
nil ) )
^^
(t NEXT 3 forms have no effect
(null (member i lst3))
(cons i nil)
nil )))) )
^^
((null (cdr i)) lst3)))
Here's your code as you probably intended it to be, with corrected parenthesization and some ifs added where needed:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x)
(t
(do ((i y (cdr i))
(lst3 x (append lst3
(cond
((listp i)
(if (null (member (car i) lst3))
(cons (car i) nil)
nil))
(t
(if (null (member i lst3))
(cons i nil)
nil))))))
((null (cdr i)) lst3)))))
There are still problems with this code. Your do logic is wrong, it skips the first element in y if it contains just one element. And you call append all the time whether it is needed or not. Note that calling (append lst3 nil) makes a copy of top-level cons cells in lst3, entirely superfluously.
Such long statements as you have there are usually placed in do body, not inside the update form for do's local variable.
But you can use more specialized forms of do, where appropriate. Here it is natural to use dolist. Following "wvxvw"'s lead on using hash-tables for membership testing, we write:
(defun stable-union (a b &aux (z (list nil)))
(let ((h (make-hash-table))
(p z))
(dolist (i a)
(unless (gethash i h)
(setf (cdr p) (list i) p (cdr p))
(setf (gethash i h) t)))
(dolist (i b (cdr z))
(unless (gethash i h)
(setf (cdr p) (list i) p (cdr p))
(setf (gethash i h) t)))))
using a technique which I call "head-sentinel" (z variable pre-initialized to a singleton list) allows for a great simplification of the code for the top-down list building at a cost of allocating one extra cons cell.
The error is because you're trying to execute the result of evaluating (null (member (car i) lst3)). In your cond expression, if i is a list, then it attempts to evaluate the expression
((null (member (car i) lst3)) (cons (car i) nil) nil))
And return the result. The first element in an expression should be a function, but
(null (member (car i) lst3))
Is going to return a boolean value. Hence the failure. The structure of your code needs some attention. What you've missed is that you need an inner cond, there.
Incidentally, this would be a much cleaner function if you did it recursively.
I'm a Schemer rather than a Lisper, but I had a little think about it. Here's the skeleton of a recursive implementation:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x)
((listp y)
(cond
((member (car y) x) (stable-union ??? (???)))
(t (stable-union (append x (??? (???))) (cdr y)))))
((not (member y x)) (append x (list y)))
(t x)))
(Edited to correct simple tyop in second-last line, thanks to Will Ness for spotting it)
(remove-duplicates (append '(a b c) '(e c d)) :from-end t)
Because you started off with do, and because a recursive solution would be even worse, here's what you could've done:
(defun union-stable (list-a list-b)
(do ((i list-b (cdr i))
filtered back-ref)
((null i) (append list-a back-ref))
(unless (member (car i) list-a)
(if back-ref
(setf (cdr filtered) (list (car i))
filtered (cdr filtered))
(setf back-ref (list (car i))
filtered back-ref)))))
This is still quadratic time, and the behaviour is such that if the first list has duplicates, or the second list has duplicates, which are not in the first list - they will stay. I'm not sure how fair it is to call this function a "union", but you'd have to define what to do with the lists if they have duplicates before you try to unify them.
And this is what you might've done if you were interested in the result, rather than just exercising. Note that it will ensure that elements are unique, even if the elements repeat in the input lists.
(defun union-stable-hash (list-a list-b)
(loop for c = (car (if list-a list-a list-b))
with back-ref
with hash = (make-hash-table)
for key = (gethash c hash)
with result
do (unless key
(if back-ref
(setf (cdr result) (list c)
result (cdr result))
(when (or list-a list-b)
(setf back-ref (list c)
result back-ref)))
(setf (gethash c hash) t))
do (if list-a (setf list-a (cdr list-a))
(setf list-b (cdr list-b)))
do (unless (or list-a list-b)
(return back-ref))))