I am using SBCL, Slime, and Emacs to develop in Common Lisp.
I have this function:
(defun build-cond-action-pairs (&rest var)
(labels ((aux (xs-left accu)
(cond ((null (cddr xs-left))
(append accu (list (list (first xs-left)
(second xs-left)))))
(t (aux (cddr xs-left)
(append accu (list (list (first xs-left)
(second xs-left)))))))))
(aux var nil)))
I also defined these two variables:
CL-USER>(defparameter var-a 1)
VAR-A
CL-USER> (defparameter var-b 1)
VAR-B
When I call the function with:
CL-USER> (build-cond-action-pairs "fish are cool" (incf var-a) "amphibians are cool" (incf var-b))
As expected, the arguments are evaluated:
(("fish are cool" 2) ("amphibians are cool" 2))
I want to transform this function into a macro. Hence, the arguments will not be evaluated.
The desired output result would be:
(("fish are cool" (incf var-a)) ("amphibians are cool" (incf var-b)))
I tried with:
CL-USER> (defmacro macro-build-cond-action-pairs (&rest var)
`(labels ((aux (,xs-left ,accu)
(cond ((null (cddr ,xs-left))
(append ,accu (list (list (first ,xs-left)
(second ,xs-left)))))
(t (aux (cddr ,xs-left)
(append ,accu (list (list (first ,xs-left)
(second ,xs-left)))))))))
(aux ,var nil)))
But, it does not work:
; in: DEFMACRO MACRO-BUILD-COND-ACTION-PAIRS
; `(LABELS ((AUX (,XS-LEFT ,ACCU)
; (COND (# #) (T #))))
; (AUX ,VAR NIL))
; --> SB-IMPL::|List| SB-IMPL::|List| SB-IMPL::|List|
; ==>
; (SB-IMPL::|List| XS-LEFT ACCU)
;
; caught WARNING:
; undefined variable: COMMON-LISP-USER::ACCU
;
; caught WARNING:
; undefined variable: COMMON-LISP-USER::XS-LEFT
;
; compilation unit finished
; Undefined variables:
; ACCU XS-LEFT
; caught 2 WARNING conditions
MACRO-BUILD-COND-ACTION-PAIRS
Feels like a package (or namespace problem). Maybe the root is the labels part. I do not know how to solve it.
How can I fix this?
Thanks.
;; from:
;; (build-cond-action-pairs "fish are cool" (incf var-a)
;; "amphibians are cool" (incf var-b))
;; the macro-expansion should be:
;; (("fish are cool" (incf var-a)) ("amphibians are cool" (incf var-b)))
;; of course, this is makeable - with common lisp.
However, macro's are then executed - and execution of this is not possible
because the first position of this list ("fish are cool" (incf var-a)) doesn't return a function.
But if the macro-expansion is
;; (list '("fish are cool" (incf var-a)) '("amphibians are cool" (incf var-b)))
;; which is equivalent to:
;; (list (quote ("fish are cool" (incf var-a))) (quote ("amphibians are cool" (incf var-b))))
;; it would evaluate to:
;; (("fish are cool" (incf var-a)) ("amphibians are cool" (incf var-b)))
This would be regular lisp.
Although it does not expand to a valid lisp expression, we can achieve it even that it expands really to:
(("fish are cool" (incf var-a)) ("amphibians are cool" (incf var-b)))
Because using macroexpand-1 you can check to what the macro expands to - no matter whether the evaluation of the expanded expression will give an error or not. So I will show you both possibilities.
;; we want
;; (macroexpand-1 '(build-cond-action-pairs "fish are cool" (incf var-a)
;; "amphibians are cool" (incf var-b)))
;; returns:
;; (("fish are cool" (incf var-a)) ("amphibians are cool" (incf var-b)))
(defmacro build-cond-action-pairs (&rest var)
...)
;; so we want this macro loops over its var elements and pairs the elements.
;; we need a function which takes a list and generates a list of lists
;; where the inner lists group pairs of elements.
;; One can achieve this with loop.
(defun to-pairs (l)
"Group elements of list l in lists of length 2 - pairs."
(loop for (a b &rest x) on l by #'cddr
collect (list a b)))
;; a macro takes its arguments list and doesn't evaluate its arguments.
;; we can use inside macros such functions to re-arrange the arguments list
;; - we can use list/data manipulation functions to re-arrange code - this
;; is the power of macros in common lisp!
(defmacro build-cond-action-pairs (&rest var)
`,(to-pairs `,var))
;; try it out:
(macroexpand-1 '(build-cond-action-pairs "fish are cool" (incf var-a)
"amphibians are cool" (incf var-b)))
;; returning:
(("fish are cool" (INCF VAR-A)) ("amphibians are cool" (INCF VAR-B))) ;
T
So this expands exactly to how you want it.
But when executing the macro there will be an error:
(build-cond-action-pairs "fish are cool" (incf var-a)
"amphibians are cool" (incf var-b))
*** - EVAL: ("fish are cool" (INCF VAR-A)) is not a function name; try using a
symbol instead
The following restarts are available:
USE-VALUE :R1 Input a value to be used instead.
ABORT :R2 Abort main loop
(I tried it out in the implementation clisp of common lisp - just because I use it for very quick tests often - while for serious programming I use emacs + sbcl).
I wanted just to demonstrate you that lisp can do even this.
So let's build the other variant with list and quote:
(defun to-quoted-pairs (l)
"Group elements of list l in quoted lists of length 2 - quoted pairs."
(loop for (a b &rest x) on l by #'cddr
collect (list 'quote (list a b))))
(defmacro build-cond-action-pairs (&rest var)
`,(to-quoted-pairs `,var))
(macroexpand-1 '(build-cond-action-pairs "fish are cool" (incf var-a)
"amphibians are cool" (incf var-b)))
;;=> ('("fish are cool" (INCF VAR-A)) '("amphibians are cool" (INCF VAR-B))) ;;=> T
This is nearly what we want - we just want to cons a #'list at the start.
So:
(defmacro build-cond-action-pairs (&rest var)
(cons 'list `,(to-quoted-pairs `,var)))
(macroexpand-1 '(build-cond-action-pairs "fish are cool" (incf var-a)
"amphibians are cool" (incf var-b)))
;;=> (LIST '("fish are cool" (INCF VAR-A))
;;=> '("amphibians are cool" (INCF VAR-B))) ;
;;=> T
;; That's it! and we can run it without error:
(build-cond-action-pairs "fish are cool" (incf var-a)
"amphibians are cool" (incf var-b))
;;=> (("fish are cool" (INCF VAR-A)) ("amphibians are cool" (INCF VAR-B)))
Voila! We made it!
#Gwang-JinKim presented a solution (thanks for the help!). However, his solution changes the recursive approach described in my original answer.
I ended up finding a way to fix the macro keeping it very similar to the original question. Basically, it was necessary to remove some commas and to insert a (quote ...) before the tail call.
Check it out:
CL-USER> (defmacro macro-build-cond-action-pairs (&rest var)
`(labels ((aux (xs-left accu)
(cond ((null (cddr xs-left))
(append accu (list (list (first xs-left)
(second xs-left)))))
(t (aux (cddr xs-left)
(append accu (list (list (first xs-left)
(second xs-left)))))))))
(aux (quote ,var) nil)))
It works:
CL-USER> (macro-build-cond-action-pairs "fish are cool" (incf var-a) "amphibians are cool" (incf var-b))
(("fish are cool" (INCF VAR-A)) ("amphibians are cool" (INCF VAR-B)))
Related
I am writing a Common Lisp macro define-computation which defines functions in a specific way and marks them by adding a property :computation to the property list of the symbol of the defined function.
The define-computation is looking for forms which are funcalls of a function with the :computation property set and wrap them with a specific code.
When I work in the REPL my code below is working as expected and macroexpansion allows me to validate that the defined-computation is properly wrapped by supervise-computation:
CL-USER> (macroexpand-1 '(define-computation c-2 ()
(c-1)
(format t "~&Compute something 2")))
(PROG1
(DEFUN C-2 ()
(DECLARE (OPTIMIZE (SAFETY 3) (SPACE 3)))
(SUPERVISE-COMPUTATION
(C-1))
(FORMAT T "~&Compute something 2"))
(EXPORT 'C-2)
(SETF (GET 'C-2 :COMPUTATION) T))
T
However when my code is organised in an ADSF system so that c-1 and c-2 are in a file and c-3 in another, I see that the code generated for c-2 is actually not wrapping c-1.
(PROG1
(DEFUN C-2 ()
(DECLARE (OPTIMIZE (SAFETY 3) (SPACE 3)))
(C-1)
(FORMAT T "~&Compute something 2"))
(EXPORT 'C-2)
(SETF (GET 'C-2 :COMPUTATION) T))
It seems to be true with SBCL and CCL64.
I am guessing this is caused by the interaction of macro expansion and loading/compiling logic but I am not well-versed enough in these aspects
of Lisp to explain and solve the undesired behaviour.
Given the code below, how can I organise it in an ADSF module so that C-1, and C-2 are defined in a file and C-3 in another, and so that the macro-expansion of C-2 features the form (SUPERVISE-COMPUTATION (C-1)) instead of just (C-1) when the system is loaded. (Again, evaluating the form below in the REPL will not display the problem.)
(defmacro supervise-computation (&body body-forms)
"Supervise the computation BODY-FORMS."
`(progn
(format t "~&---> Computation starts")
,#body-forms
(format t "~&---> Computation stops")))
(defun define-computation/wrap-computation-forms (body-forms)
"Walks through BODY-FORMS and wrap computation forms in a fixture."
(labels
((is-funcall-p (form)
(when (and (listp form) (not (null form)) (symbolp (first form)) (listp (rest form)))
(case (first form)
((funcall apply)
(second form))
(t (first form)))))
(is-computation-form-p (form)
(get (is-funcall-p form) :computation))
(wrap-computation-forms (form)
(cond
((is-computation-form-p form)
`(supervise-computation ,form))
((is-funcall-p form)
(cons (first form) (mapcar #'wrap-computation-forms (rest form))))
(t
form))))
(mapcar #'wrap-computation-forms body-forms)))
(defmacro define-computation (computation-name computation-args &body body)
`(prog1
(defun ,computation-name ,computation-args
(declare (optimize (safety 3) (space 3)))
,#(define-computation/wrap-computation-forms body))
(export (quote ,computation-name))
(setf (get (quote ,computation-name) :computation) t)))
(define-computation c-1 ()
(format t "~&Compute something 1"))
(define-computation c-2 ()
(c-1)
(format t "~&Compute something 2"))
(define-computation c-3 ()
(c-2)
(format t "~&Compute something 3"))
Sleeping over it and looking at other people's code (thank you anaphora) I could figure out a better way to write the macro is
(defmacro define-computation (computation-name computation-args &body body)
(setf (get computation-name :computation) t)
`(prog1
(defun ,computation-name ,computation-args
(declare (optimize (safety 3) (space 3)))
,#(define-computation/wrap-computation-forms body)
(export (quote ,computation-name))))
This ensures the property is set at macro evaluation time.
I am working my way through Practical Common Lisp. I got to the example where you define a deftest macro that works like defun with some added functionality. This got me thinking that it would be nice to be able to add a docstring. I have found that both of the following work, but is one of them more correct? Is there a "right" way to achieve the optional-docstring-like behaviour of defun?
(defmacro deftest (name parameters &body body)
(let ((docstring ""))
(when (stringp (car body)) (setf docstring (car body) body (cdr body)))
`(defun ,name ,parameters
,docstring
(let ((*test-name* (append *test-name* (list ',name))))
,#body))))
(defmacro deftest (name parameters &optional docstring &body body)
(when (not (stringp docstring)) (setf docstring ""))
`(defun ,name ,parameters
,docstring
(let ((*test-name* (append *test-name* (list ',name))))
,#body)))
In general you probably want to parse out both a possible docstring and any declarations from the body of the function, so you can put the declarations where they belong. I use something like this:
(defun parse-body (body)
(multiple-value-bind (docstring decls/forms)
(if (stringp (first body))
(values (first body) (rest body))
(values nil body))
(loop for remainder on decls/forms
while (and (not (null remainder))
(consp (first remainder))
(eql (car (first remainder)) 'declare))
collect (first remainder) into decls
finally (return (values docstring decls remainder)))))
And then your deftest would be
(defmacro deftest (name parameters &body body)
(multiple-value-bind (docstring decls forms) (parse-body body)
`(defun ,name ,parameters
,#(if docstring (list docstring) '())
,#decls
(let ((*test-name* (append *test-name* (list ',name))))
,#forms))))
I wish I could say that I have a standard parse-body function, but I don't: I just write a new one each time.
From reading a Lisp book I remember they showed an example of an OOP-style method dispatcher based on closures:
(defun create-object ()
(let ((val 0)
(get (lambda () val))
(set (lambda (new-val) (setq val new-val)))
(inc (lambda () (setq val (+ 1 val)))))
(lambda (method)
(cond ((eq method 'get)
get)
((eq method 'set)
set)
((eq method 'inc)
inc)))))
(let ((obj (create-object)))
(funcall (obj 'set) 1)
(funcall (obj 'inc))
(funcall (obj 'get))) ;; 2
Since it's just a function with a string symbol argument, I guess code intel won't be of much help here, not completing the method names or their signatures. (Compare with a similar JavaScript object.)
Is this problem generally solved? How do you program an object system in Scheme so that an editor (like Emacs) can be more intelligent with your code?
P.S. The example may be not a valid Scheme code, but you should get the idea.
I've made some starting code for you.
It's for Emacs Lisp, but it's should be very easily portable to Scheme.
Here's your usage example:
(defun create-object ()
(lexical-let* ((val 0)
(get (lambda() val))
(set (lambda(x) (setq val x))))
(generate-dispatch-table get set)))
(setq obj (create-object))
(funcall (funcall obj 'get))
;; => 0
(funcall (funcall obj 'set) 1)
;; => 1
(funcall (funcall obj 'get))
;; => 1
(scheme-completions obj)
;; => (get set)
And here's how it's implemented:
(defmacro generate-dispatch-table (&rest members)
`(lambda (method)
(cond ,#(mapcar
(lambda (x) `((eq method ',x) ,x)) members))))
(defun collect (pred x)
(when (and x (listp x))
(let ((y (funcall pred x))
(z (append
(collect pred (car x))
(collect pred (cdr x)))))
(if y
(append (list y) z)
z))))
(defun scheme-completions (obj)
(collect
(lambda(x) (and (eq (car x) 'eq)
(eq (cadr x) 'method)
(eq (caaddr x) 'quote)
(cadr (caddr x))))
obj))
And here's a simple visual interface for completions:
(require 'helm)
(defun scheme-completions-helm ()
(interactive)
(let ((y (and
(looking-back "(funcall \\([^ ]*\\) +")
(intern-soft (match-string 1)))))
(when y
(helm :sources
`((name . "members")
(candidates . ,(scheme-completions (eval y)))
(action . (lambda(x) (insert "'" x))))))))
I'm not a Emacs user, but use DrRacket and it does have an object system and do what an IDE should do, but I know Emacs is very customizable since it uses elisp so you can make support for your own syntax both in syntax highlighting and tab-completion. So you do:
Make your own object system
Edit your Emacs editor to do what you want
Many of my colleagues use it and they fix their Emacs in such ways.
Another thing, this question makes me think about the resources at schemewiki.org on the subject where the different approaches are mentioned and even a similar code to the one you posted is posted as example. It's a good read.
I would avoid double notion of symbols in create-object via an obarray.
Furthermore, the interface of the object are all functions. Therefore, use fset and avoid the double funcall.
(defun create-object ()
(lexical-let (val
(_oa (make-vector 11 0)))
(fset (intern "get" _oa) (lambda () val))
(fset (intern "inc" _oa) (lambda () (incf val)))
(fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
(lambda (method &rest args)
(apply 'funcall (intern (symbol-name method) _oa) args))))
(fset 'obj1 (create-object))
(fset 'obj2 (create-object))
(obj1 'set 1)
(obj2 'set 2)
(obj1 'inc)
(obj2 'inc)
(obj2 'inc)
(obj2 'get)
(obj1 'get)
Example for inheritance:
(defun create-object ()
(lexical-let (val
(_oa (make-vector 11 0)))
(fset (intern "get" _oa) (lambda () val))
(fset (intern "inc" _oa) (lambda () (incf val)))
(fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
(lambda (method &rest args)
(apply 'funcall (or (intern-soft (symbol-name method) _oa)
(error "Undefined function: %s" method))
args))))
(defun create-object-add10 ()
(lexical-let ((base (create-object))
(_oa (make-vector 11 0)))
(fset (intern "inc" _oa) (lambda () (funcall base 'set (+ (funcall base 'get) 10))))
(lambda (method &rest args)
(let ((call (intern-soft (symbol-name method) _oa)))
(if call
(apply 'funcall call args)
(apply 'funcall base method args))))))
(fset 'obj1 (create-object))
(fset 'obj2 (create-object-add10))
(obj1 'set 1)
(obj2 'set 2)
(obj1 'inc)
(obj2 'inc)
(obj2 'inc)
(obj2 'get)
(obj1 'get)
The definition of create-object-like methods should additionally be supported through macros. That is not done here.
For more features, note, there is a CLOS-compatible object oriented system in emacs:
https://www.gnu.org/software/emacs/manual/html_node/eieio/index.html
I would like to create a function that allows to:
(incf vara varb varc vard)
Instead of
(incf vara)
(incf varb)
(incf varc)
(incf vard)
What I do not understand is how to be able to send more arguments, how to define that in a function?
(defun inc (&rest arg)
(interactive)
(mapcar 'incf arg)
)
This increases the argument, but ofcourse does not save them back into the variables.
How to go about this?
If you want to be able to write this form as (my-incf a b c) without quoting the variable names a, b, and c, make it a macro rather than a function:
(defmacro incf+ (&rest vars)
`(progn
,#(mapcar (lambda (var) `(incf ,var)) vars)))
Check that it expands into the right code using macroexpand:
(macroexpand '(incf+ var1 var2 var3))
;; => (progn (incf var1) (incf var2) (incf var3))
Because variables in Emacs Lisp have dynamic scope by default, you can accomplish almost the same thing with a function which takes quoted variable names as arguments. But the macro version has the advantage that, since it expands into code in the place when it was called, it will work with lexically bound variables as well. symbol-value only works with dynamically bound variables.
You can test this by putting the following in a file and loading it (in Emacs 24 or higher):
;; -*- lexical-binding: t -*-
(defun incf+fun (&rest vars)
(mapc #'(lambda (var) (incf (symbol-value var))) vars))
(defun incf-macro-test ()
(let ((a 5) (b 7) (c 11))
(incf+ a b c)
(list a b c)))
(defun incf-function-test ()
(let ((a 5) (b 7) (c 11))
(incf+fun 'a 'b 'c)
(list a b c)))
Evaluating (incf-macro-test) will return (6 8 12), but (incf-function-test) will enter the debugger with a (void-variable a) error.
It should work:
(require 'cl)
(setq a 1)
(setq b 2)
(defun inc (&rest arg)
(interactive)
(mapc (lambda (x) (incf (symbol-value x))) arg))
(inc 'a 'b)
(message "%s %s" a b) => (2 3)
You have to quote each argument otherwise (inc a b) becomes (inc 1 2) before executing inc.
I'm working on actually writing something on my own in Common Lisp for once, implementing the Shunting-yard Algorithm. I thought it went okay, even if it came out rather ugly and if I doubt its Lispy-ness, but upon testing out the function in the REPL, I get the error in the title.
The code is as follows, with the test case being (shunting-yard '(3 + 5)).
(defparameter *output-queue* nil)
(defparameter *operator-stack* nil)
(defun determine-precedence (operator)
(case operator
(('+ '-) 2)
(('* '/) 3)
('^ 4)))
(defun shunting-yard (stmt)
(loop until (null stmt) do
(let ((token (car stmt)))
(cond ((or (numberp token)
(eq token '\())
(setf *output-queue* (cons token *output-queue*)))
((mapcar #'(lambda (x) (eq token x)) '(+ - * / ^))
(let* ((token-precedence (determine-precedence token))
(stack-topmost (car *operator-stack*))
(stack-precedence (determine-precedence stack-topmost)))
(when (< token-precedence stack-precedence)
(setf *output-queue* (cons stack-topmost *output-queue*))
(setf *operator-stack* (cdr *operator-stack*)))
(setf *operator-stack* (cons token *operator-stack*))))
((eq token '\))
(loop for stack-topmost in *operator-stack*
until (eq stack-topmost '\()
do (progn
(setf *output-queue* (cons stack-topmost *output-queue*))
(setf *operator-stack* (cdr *operator-stack*)))
finally (setf *operator-stack* (cdr *operator-stack*)))))
(setf stmt (cdr stmt))))
(loop while (not (null *operator-stack*))
do (progn
(setf *output-queue* (cons (car *operator-stack*) *output-queue*))
(setf *operator-stack* (cdr *operator-stack*))))
(nreverse *output-queue*))
Is the error in the code itself (my guess) or is it in my test case?
Thanks so much in advance, this was REALLY fun to write and I can't wait to work on something else, but only after I get this working.
There are several errors:
First:
(defun determine-precedence (operator)
(case operator
(('+ '-) 2)
(('* '/) 3)
('^ 4)))
The quotes need to go. All.
Second:
(mapcar #'(lambda (x) (eq token x)) '(+ - * / ^))
Above is not doing what you think. Replace it with a call to MEMBER.
Third:
(when (< token-precedence stack-precedence)
You need to make sure that the variables are really bound to numbers.
Use something like
(check-type token-precedence number)
(check-type stack-precedence number)
before as a check.
Happy further debugging...