For a college project we're working on learning scheme however we've been thrown into a difficult assignment with little knowledge. We're given certain functions like "'let", "'cond", "and'" etc. and asked to add macros.
(define eval
(λ (e env)
(cond ((symbol? e) (lookup-var e env))
((not (list? e)) e) ; non-list non-symbol is self evaluatory
;; special forms go here:
((equal? (car e) 'λ) ; (λ VARS BODY)
(let ((vars (cadr e)) (body (caddr e)))
(list '%closure vars body env)))
((equal? (car e) 'if)
(eval_ (if (eval_ (cadr e) env) (caddr e) (cadddr e)) env))
((equal? (car e) 'quote) (cadr e))
;; Add More Macros Here:
;; ((equal? (car e) 'let) xxx)
;;((equal? (car e) 'cond) xxx)
;;((equal? (car e) 'and) xxx)
;((equal? (car e) 'or) xxx)
(else (let ((eeoe (map (λ (e0) (eval_ e0 env)) e)))
(apply_ (car eeoe) (cdr eeoe)))))))
So basically we're asked to fill in the blanks, where the ';;' comments are.
I tried doing the 'cond part and got this
((equal? (car e) 'cond)
(env (cdr e) env))
But I have no idea if it's correct (very little knowledge of scheme). Any help in figuring this out will be much appreciated. Thanks.
It's not really macros but special forms you are adding. If you know that let is just syntax sugar for anonymous function call. eg.
(let ((a expr1) (b expr2)) body ...)
is supported in you evaluator already if you change and evaluate:
((lambda (a b) body ...) expr1 expr2)
To get you going let works like this:
(let ((bindings (cadr e))
(body (cddr e)))
(eval_ `((lambda ,(map car bindings) ,#body) ,#(map cadr bindings))))
Now real macros you would introduce a new type of %closure so that whenever you find it as operator you bind the symbols not their evaluation, run the evaluator on it as if it was a function, then do _eval on the result. Then instead of implementing cond and let you could just add a function on how to rewrite it down to something you already support. Thus you could make let like this:
((lambda (let)
(let ((a expr1) (b expr2))
(cons a b)))
(~ (bindings . body) `((lambda ,(map car bindings) ,#body) ,#(map cadr bindings))))
It assumes you have quasiquote and map, but it could easily be implemented without these with more verbose code. ~ is just chosen randomly to be the macro version of λ. When evaluated it makes perhaps a %mclosure structure and you need to handle it specially to not evaluate its arguments, but evalaute the result. From that on you could support the special forms by having predefined %mclosure in the boot environment.
Related
I am just now learning about macros. I find them really cool as a concept, but I still have a really hard time programming them, as this post will amply demonstrate.
I'm posting this question because I could not solve an exercise I set up for myself.
Basically, I want to define the "macro-equivalent" of the following function:
(defun fn-get-at (deeply-nested-thing address)
(if address
(if (eql (car address) 'l)
(fn-get-at (caar deeply-nested-thing) (cdr address))
(fn-get-at (cddr deeply-nested-thing) (cdr address)))
deeply-nested-thing))
As an example of how one would use this function, if I first set
(setf deeply-nested-thing
'((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))
...then I could evaluate (fn-get-at deeply-nested-thing '(l l r)) to get ((NIL) P). In this example, the address parameter is the list '(l l r), where the 'l and 'r stand for "go left" and "go right", respectively. One can think of this list as a set of directions, starting from the root node of some binary tree1.
So far, so good. Now I would like to define macro-get-at, a macro version of fn-get-at. With this macro, the expression (macro-get-at deeply-nested-thing '(l l r)) should expand to2
(cddr (caar (caar deeply-nested-thing)))
My first attempt was this:
(defmacro macro-get-at (deeply-nested-thing address)
(if address
(if (eql (car address) 'l)
`(macro-get-at (caar ,deeply-nested-thing) ,(cdr address))
`(macro-get-at (cddr ,deeply-nested-thing) ,(cdr address)))
deeply-nested-thing))
This did not meet my already extremely low expectations. I had expected that
(pprint (macroexpand-1 '(macro-get-at deeply-nested-thing '(l l r))))
...would, at worst, output something like
(MACRO-GET-AT (CAAR DEEPLY-NESTED-THING) '(L R))
Instead, I got this:
(MACRO-GET-AT (CDDR DEEPLY-NESTED-THING) ((L L R)))
To me, baffling. First, since the output has CDDR rather than CAAR, I must conclude that the (eql (car address) 'l) test in macro-get-at evaluated to nil; I don't get it: the same test behaves correctly in fn-get-at. Second, I just can't make any sense of that ((L L R)) in the output.
My second (and final) attempt was this:
(defmacro macro-get-at (deeply-nested-thing address)
(if address
(if (eql (car address) 'l)
`(macro-get-at (caar ,deeply-nested-thing) (cdr ,address))
`(macro-get-at (cddr ,deeply-nested-thing) (cdr ,address)))
deeply-nested-thing))
The results of this are marginally better, but still completely wrong. The macroexpand-1 output this time is:
(MACRO-GET-AT (CDDR DEEPLY-NESTED-THING) (CDR '(L L R)))
Again, the CDDR is wrong (though that's to be expected, since my new version does not address this problem at all). The second argument in the expansion is at least nominally correct, but if one simulates recursively expanding the resulting macro expression, one can see that the process will be an infinite loop (since the second argument of every expansion will always be non-null):
* (pprint (macroexpand-1 (macroexpand-1 (macroexpand-1 (macroexpand-1 '(macro-get-at deeply-nested-thing '(l l r)))))))
(MACRO-GET-AT (CDDR (CDDR (CDDR (CDDR DEEPLY-NESTED-THING))))
(CDR (CDR (CDR (CDR '(L L R))))))
I hope that by now I have given enough evidence of my cluelessness to elicit the flinging of a few merciful cluebricks my way.
1 Granted, in this example, it is not at all easy, at least for me, to see that the sequence "turn left, turn left, turn right" corresponds to ((NIL) P).
2 Note that the order of caar's and cddr's corresponds to the order of the reverse of the "address" '(l l r).
Your first attempt works.
(defparameter *deeply-nested-thing*
'((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))
(defmacro macro-get-at (deeply-nested-thing address)
(if address
(if (eql (car address) 'l)
`(macro-get-at (caar ,deeply-nested-thing) ,(cdr address))
`(macro-get-at (cddr ,deeply-nested-thing) ,(cdr address)))
deeply-nested-thing))
CL-USER 14 > (macroexpand '(macro-get-at *deeply-nested-thing* (l l r)))
(CDDR (CAAR (CAAR *DEEPLY-NESTED-THING*)))
T
CL-USER 12 > (macro-get-at *deeply-nested-thing* (l l r))
((NIL) P)
Macros don't evaluate their arguments, so list of directions has to be written as (l l r). In each step of recursion, car is removed:
(cdr (l l r)) => (L R)
(cdr (L R)) => (R)
(cdr (R)) => NIL
You used '(l l r)- and this happened inside macro:
(cdr (quote (l l r)) => ((L L R))
(cdr ((L L R))) => NIL
Replacing functions by macros is never a good idea in a modern Lisp (there were some uses for it in very antique Lisps). Macros transform source code to other source code: a macro compiles a language into a simpler language, it does not operate on run-time data.
So what you need to be thinking about is what language this macro will understand and what it needs to emit. Well, the language it consumes is something like:
a name for some kind of expression;
a list of the names of zero or more single-argument operations to perform on that expression, in the order given, with the value of each operation being the argument to the next.
And the language it will produce is going to be a bit of CL source which does this.
So, well, lets first write a slightly simpler thing than yours. Lets write a macro which lets you, for instance say:
(-> thing car cdr cdr)
and will turn this into (cdr (cdr (car thing)))
Note this takes any number of arguments, not an argument and an argument which must be a list of operations, because why have extra useless parens?
Note also that this is kind of like a Unix pipeline: it pipes its first argument through a number of operations
Here's a macro which does that: as with many cases where you have something with an &rest argument it's usually convenient to do most of the work with an auxiliary function:
(defmacro -> (e &body opnames)
(labels ((expand-> (otail)
(if (null otail)
e
`(,(first otail) ,(expand-> (rest otail))))))
(expand-> (reverse opnames))))
Another way to implement this which in some ways is nicer (well, I think so) is:
(defmacro -> (e &body opnames)
(do* ((otail opnames (rest otail))
(expression (if (not (null otail))
`(,(first otail) ,e)
e)
(if (not (null otail))
`(,(first otail) ,expression)
expression)))
((null otail) expression)))
So now we've got this thing, but we're stuck with operation names being function names. But that's fine, we can now turn this into something very close to your get-at macro:
(defmacro get-at (thing &body lrs)
`(-> ,thing ,#(mapcar (lambda (op)
(ecase op
(l 'caar)
(r 'cddr))) lrs)))
And now you have both get-at and a much more general tool.
Solution by a function
Though the question is about a macro, this can be solved entirely by a function:
(defun get-at (nested-thing commands)
(let ((result nested-thing)
(lookup (list (cons 'l #'caar) (cons 'r #'cddr))))
(loop for c in commands
do (setf result (funcall (cdr (assoc c lookup)) result))
finally (return result))))
This function is like an interpreter for the mini l-r-language.
Let's test:
(setf deeply-nested-thing
'((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))
(get-at deeply-nested-thing '(l l r))
;; => ((NIL) P)
Solution by a macro
As a macro, you could construct the code using cons into code:
(defmacro get-at (nested-thing commands)
(let ((atable '((l . caar) (r . cddr)))
(code (list nested-thing)))
(loop for c in commands
do (setf code (list (cons (cdr (assoc c atable)) code)))
finally (return (car code)))))
Test it:
(macroexpand-1 '(get-at deeply-nested-thing (l l r)))
;; (CDDR (CAAR (CAAR DEEPLY-NESTED-THING))) ;
;; T
(get-at deeply-nested-thing (l l r))
;; => ((NIL) P)
I need to write the lisp macro in scheme (please on hygienic macros and syntax-rules etc) that will have function call and Alist as argument
I want function and macro that call that function to have syntax like this:
(foo '(10 (a (lambda () (display "10")) b (lambda () (display "20"))))
or macro without quotes.
My last code is working, but not sure if this is how you suppose to write function/macro like this. It seems that I need double backquote but don't know how to write it. (I'm right now reading On Lips by Paul Graham and he said that double backquote is very hard and only need by macros defining macros, but It seems that this is what I need).
(define (foo expr)
`(list ,(car expr)
(,(string->symbol "quasiquote") ,(pair-map (lambda (a b)
(cons (symbol->string a)
(list 'unquote b)))
(cadr expr)))))
(define-macro (bar expr)
(foo expr))
(define xx (bar (10 (a 20 b (lambda () (display "x") (newline))))))
;; (list 10 `((a . ,20) (b . ,(lambda () (display "x") (newline))))
(define bfn (cdr (assoc "b" (cadr xx)))))
(bfn)
;; "x"
and here is definition of pair-map
(define (pair-map fn seq-list)
"(seq-map fn list)
Function call fn argument for pairs in a list and return combined list with
values returned from function fn. It work like the map but take two items from list"
(let iter ((seq-list seq-list) (result '()))
(if (null? seq-list)
result
(if (and (pair? seq-list) (pair? (cdr seq-list)))
(let* ((first (car seq-list))
(second (cadr seq-list))
(value (fn first second)))
(if (null? value)
(iter (cddr seq-list) result)
(iter (cddr seq-list) (cons value result))))))))
with (string->symbol "quasiquote") I was able not to use double backquote, can this be written with double backquote/quasiquote? How this should look like?
I'm asking if this can be written different way so I can fix few issues in my own lisp interpreter (not sure if is working correctly but it seems that this final version works the same in guile).
I came up with shorter quasiquote version, but still it require inserting symbols:
(define (foo expr)
`(list ,(car expr)
(,'quasiquote ,(pair-map (lambda (a b)
`(,(symbol->string a) . (,'unquote ,b)))
(cadr expr)))))
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.
When I compile the following code, SBCL complains that g!-unit-value and g!-unit are undefined. I'm not sure how to debug this. As far as I can tell, flatten is failing.
When flatten reaches the unquoted part of defunits, it seems like the entire part is being treated as an atom. Does that sound correct?
The following uses code from the book Let over Lambda:
Paul Graham Utilities
(defun symb (&rest args)
(values (intern (apply #'mkstr args))))
(defun mkstr (&rest args)
(with-output-to-string (s)
(dolist (a args) (princ a s))))
(defun group (source n)
(if (zerop n) (error "zero length"))
(labels ((rec (source acc)
(let ((rest (nthcdr n source)))
(if (consp rest)
(rec rest (cons (subseq source 0 n) acc))
(nreverse (cons source acc))))))
(if source (rec source nil) nil)))
(defun flatten (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
Let Over Lambda Utilities - Chapter 3
(defmacro defmacro/g! (name args &rest body)
(let ((g!-symbols (remove-duplicates
(remove-if-not #'g!-symbol-p
(flatten body)))))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (g!-symbol)
`(,g!-symbol (gensym ,(subseq
(symbol-name g!-symbol)
2))))
g!-symbols)
,#body))))
(defun g!-symbol-p (symbol-to-test)
(and (symbolp symbol-to-test)
(> (length (symbol-name symbol-to-test)) 2)
(string= (symbol-name symbol-to-test)
"G!"
:start1 0
:end1 2)))
(defmacro defmacro! (name args &rest body)
(let* ((o!-symbols (remove-if-not #'o!-symbol-p args))
(g!-symbols (mapcar #'o!-symbol-to-g!-symbol o!-symbols)))
`(defmacro/g! ,name ,args
`(let ,(mapcar #'list (list ,#g!-symbols) (list ,#o!-symbols))
,(progn ,#body)))))
(defun o!-symbol-p (symbol-to-test)
(and (symbolp symbol-to-test)
(> (length (symbol-name symbol-to-test)) 2)
(string= (symbol-name symbol-to-test)
"O!"
:start1 0
:end1 2)))
(defun o!-symbol-to-g!-symbol (o!-symbol)
(symb "G!" (subseq (symbol-name o!-symbol) 2)))
Let Over Lambda - Chapter 5
(defun defunits-chaining (u units prev)
(if (member u prev)
(error "~{ ~a~^ depends on~}"
(cons u prev)))
(let ((spec (find u units :key #'car)))
(if (null spec)
(error "Unknown unit ~a" u)
(let ((chain (second spec)))
(if (listp chain)
(* (car chain)
(defunits-chaining
(second chain)
units
(cons u prev)))
chain)))))
(defmacro! defunits (quantity base-unit &rest units)
`(defmacro ,(symb 'unit-of- quantity)
(,g!-unit-value ,g!-unit)
`(* ,,g!-unit-value
,(case ,g!-unit
((,base-unit) 1)
,#(mapcar (lambda (x)
`((,(car x))
,(defunits-chaining
(car x)
(cons
`(,base-unit 1)
(group units 2))
nil)))
(group units 2))))))
This is kind of tricky:
Problem: you assume that backquote/comma expressions are plain lists.
You need to ask yourself this question:
What is the representation of a backquote/comma expression?
Is it a list?
Actually the full representation is unspecified. See here: CLHS: Section 2.4.6.1 Notes about Backquote
We are using SBCL. See this:
* (setf *print-pretty* nil)
NIL
* '`(a ,b)
(SB-INT:QUASIQUOTE (A #S(SB-IMPL::COMMA :EXPR B :KIND 0)))
So a comma expression is represented by a structure of type SB-IMPL::COMMA. The SBCL developers thought that this representation helps when such backquote lists need to be printed by the pretty printer.
Since your flatten treats structures as atoms, it won't look inside...
But this is the specific representation of SBCL. Clozure CL does something else and LispWorks again does something else.
Clozure CL:
? '`(a ,b)
(LIST* 'A (LIST B))
LispWorks:
CL-USER 87 > '`(a ,b)
(SYSTEM::BQ-LIST (QUOTE A) B)
Debugging
Since you found out that somehow flatten was involved, the next debugging steps are:
First: trace the function flatten and see with which data it is called and what it returns.
Since we are not sure what the data actually is, one can INSPECT it.
A debugging example using SBCL:
* (defun flatten (x)
(inspect x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
STYLE-WARNING: redefining COMMON-LISP-USER::FLATTEN in DEFUN
FLATTEN
Above calls INSPECT on the argument data. In Common Lisp, the Inspector usually is something where one can interactively inspect data structures.
As an example we are calling flatten with a backquote expression:
* (flatten '`(a ,b))
The object is a proper list of length 2.
0. 0: SB-INT:QUASIQUOTE
1. 1: (A ,B)
We are in the interactive Inspector. The commands now available:
> help
help for INSPECT:
Q, E - Quit the inspector.
<integer> - Inspect the numbered slot.
R - Redisplay current inspected object.
U - Move upward/backward to previous inspected object.
?, H, Help - Show this help.
<other> - Evaluate the input as an expression.
Within the inspector, the special variable SB-EXT:*INSPECTED* is bound
to the current inspected object, so that it can be referred to in
evaluated expressions.
So the command 1 walks into the data structure, here a list.
> 1
The object is a proper list of length 2.
0. 0: A
1. 1: ,B
Walk in further:
> 1
The object is a STRUCTURE-OBJECT of type SB-IMPL::COMMA.
0. EXPR: B
1. KIND: 0
Here the Inspector tells us that the object is a structure of a certain type. That's what we wanted to know.
We now leave the Inspector using the command q and the flatten function continues and returns a value:
> q
(SB-INT:QUASIQUOTE A ,B)
For anyone else who is trying to get defmacro! to work on SBCL, a temporary solution to this problem is to grope inside the unquote structure during the flatten procedure recursively flatten its contents:
(defun flatten (x)
(labels ((flatten-recursively (x flattening-list)
(cond ((null x) flattening-list)
((eq (type-of x) 'SB-IMPL::COMMA) (flatten-recursively (sb-impl::comma-expr x) flattening-list))
((atom x) (cons x flattening-list))
(t (flatten-recursively (car x) (flatten-recursively (cdr x) flattening-list))))))
(flatten-recursively x nil)))
But this is horribly platform dependant. If I find a better way, I'll post it.
In case anyone's still interested in this one, here are my three cents. My objection to the above modification of flatten is that it might be more naturally useful as it were originally, while the problem with representations of unquote is rather endemic to defmacro/g!. I came up with a not-too-pretty modification of defmacro/g! using features to decide what to do. Namely, when dealing with non-SBCL implementations (#-sbcl) we proceed as before, while in the case of SBCL (#+sbcl) we dig into the sb-impl::comma structure, use its expr attribute when necessary and use equalp in remove-duplicates, as we are now dealing with structures, not symbols. Here's the code:
(defmacro defmacro/g! (name args &rest body)
(let ((syms (remove-duplicates
(remove-if-not #-sbcl #'g!-symbol-p
#+sbcl #'(lambda (s)
(and (sb-impl::comma-p s)
(g!-symbol-p (sb-impl::comma-expr s))))
(flatten body))
:test #-sbcl #'eql #+sbcl #'equalp)))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (s)
`(#-sbcl ,s #+sbcl ,(sb-impl::comma-expr s)
(gensym ,(subseq
#-sbcl
(symbol-name s)
#+sbcl
(symbol-name (sb-impl::comma-expr s))
2))))
syms)
,#body))))
It works with SBCL. I have yet to test it thoroughly on other implementations.
i worte this function to remove numbers from a list x
(defun rm-nums (x)
(cond
((null x) nil)
(t (mapcar 'numberp x))))
however when i enter (rm-nums '(32 A T 4 3 E))
returns (T NIL NIL T T NIL)
i want it instead of returning T or Nil, i want it to return the values that caused NIL only [which are not numbers]
so this example should return (A T E)
i am supposed to use mapcar WITHOUT recursion or iteration or the bultin function "remove-if"
i think it is related to something called apply-append but i know nothing about it. any help?
I think your course had this in mind:
(defun my-remove-if (pred lst)
(apply #'append (mapcar (lambda (x)
(and (not (funcall pred x))
(list x)))
lst)))
It does use apply and append and mapcar, like you said. Example usage:
(my-remove-if #'numberp '(32 a t 4 3 e))
=> (a t e)
More idiomatic solution suggested by Rörd:
(defun my-remove-if (pred lst)
(mapcan (lambda (x)
(and (not (funcall pred x))
(list x)))
lst))