eval macro Unbound variable (CHICKEN Scheme) - macros

I'm trying to eval a list with variables inside a macro function that defines a variable in a lambda but the eval in it can't
(define-syntax MYVAR
(syntax-rules ()
[(_ varname value body ...) ((lambda (varname) body ...) value)]))
(define mylist '(list P Q))
(print mylist)
(MYVAR P 1
(MYVAR Q 2
(print P Q) ;;everything prints fine in here
(print (eval mylist))))
<eval> ((lambda2127 (P) (MYVAR Q 2 (print P Q) (print (eval mylist)))) 1)
<eval> ((lambda2129 (Q) (print P Q) (print (eval mylist))) 2)
<eval> (print P Q)
<eval> (print (eval mylist))
<eval> (eval mylist)
<syntax> (list P Q)
<eval> (list P Q) <--
=> Error: unbound variable: P
I assume eval tries to evaluate before my macro compiles but not sure,
is there a way to reuse a list and evaluate it inside a macro?
I have tried to use define-for-syntax but the same error arises

I'd recommend that you try:
(MYVAR P 1
(MYVAR Q 2
((print (eval 'mylist)))))
After this your output should be
(list P Q)
Why did this work?
In Scheme, code is nested using parentheses.
So, for example
(print (eval (list 1 2 3)))
Scheme will try and find the definition of 1 and pass 2 and 3 as arguments.
Whereas
(print (eval '(list 1 2 3)))
Will print
(list 1 2 3)
In short, the single quote is like an escape character.

Related

Generate TYPECASE with macro in Common Lisp

I have a list of two element sublists which will change and grow in the course of the program. I want to write a macro which takes a key and generates a case dynamically like:
;; This is the List for saving CASE clauses
(setf l '((number 2) (symbol 3)))
;; and i want to have the following expansion
(typecase 'y
(number 2)
(symbol 3))
I could have a macro which only refers to the global l:
(defmacro m (x)
`(typecase ,x ,#l))
which would expand correctly
(m 'y) ;expands to (TYPECASE 'Y (number 2) (symbol 3))
But how can i write the macro with a parameter for the list l so that it would work with other lists as well?
;; A macro which should generate the case based on the above list
(defmacro m (x l)
`(typecase ,x ,#l))
This doesn't work since l in the arguments list i a symbol and a call to (m 'y l) will expand to (TYPECASE 'Y . L).
Wanting to adhere to typecase mechanism, my workaround was as follows:
(setf types-x '(((integer 0 *) 38)
((eql neli) "Neli in X")
(symbol 39))
)
(setf types-y '(((eql neli) "Neli in Y")
((array bit *) "A Bit Vector")))
(defmacro m (x types-id)
(case types-id
(:x `(typecase ,x ,#types-x))
(:y `(etypecase ,x ,#types-y))))
(m 'neli :x) ;"Neli in X"
(m 'neli :y) ;"Neli in Y"
(m 'foo :x) ;39
Any hints and comments is appreciated.
You don't need a macro for what you're trying to do: use a function.
For instance, given
(defvar *type-matches*
'((float 0)
(number 1)
(t 3)))
Then
(defun type-match (thing &optional (against *type-matches*))
(loop for (type val) in against
when (typep thing type)
return (values val type)
finally (return (values nil nil))))
Will match a thing against a type:
> (type-match 1.0)
0
float
> (type-match 1)
1
number
You want to keep the variables sorted by type, which you can do by, for instance:
(setf *type-matches* (sort *type-matches* #'subtypep :key #'car))
You want to keep the matches sorted of course.
If you want to delay the execution of the forms then you can do something like this (this also deals with sorting the types):
(defvar *type-matches*
'())
(defmacro define-type-match (type/spec &body forms)
;; define a type match, optionally in a specified list
(multiple-value-bind (type var)
(etypecase type/spec
(symbol (values type/spec '*type-matches*))
(cons (values (first type/spec) (second type/spec))))
(let ((foundn (gensym "FOUND")))
`(let ((,foundn (assoc ',type ,var :test #'equal)))
(if ,foundn
(setf (cdr ,foundn) (lambda () ,#forms))
(setf ,var (sort (acons ',type (lambda () ,#forms) ,var)
#'subtypep :key #'car)))
',type/spec))))
(defun type-match (thing &optional (against *type-matches*))
(loop for (type . f) in against
when (typep thing type)
return (values (funcall f) type)
finally (return (values nil nil))))
The actual problem that you face is that if you do
(setf l '((number 2) (symbol 3)))
already on toplevel, if you evaluate l, you don't come further than
((number 2) (symbol 3))
So if you use l in a macro as an argument, you can't come further
than this. But what you need is to evaluate this form (modified after adding a typecase and an evaluated x upfront) once more within the macro.
This is, why #tfb suggested to write a function which actually evaluates the matching of the types specified in l.
So, we could regard his type-match function as a mini-interpreter for the type specifications given in l.
If you do a simple (defmacro m (x l) `(typecase ,x ,#l))
you face exactly that problem:
(macroexpand-1 '(m 1 l))
;; (typecase 1 . l)
but what we need is that l once more evaluated.
(defmacro m (x l)
`(typecase ,x ,#(eval l)))
Which would give the actually desired result:
(macroexpand-1 '(m 1 l))
;; (TYPECASE 1 (NUMBER 2) (SYMBOL 3)) ;
;; T
;; and thus:
(m 1 l) ;; 2
So far, it seems to work. But somewhere in the backhead it becomes itchy, because we know from books and community: "Don't use eval!! Eval in the code is evil!"
Trying around, you will find out when it will bite you very soon:
# try this in a new session:
(defmacro m (x l) `(typecase ,x ,#(eval l)))
;; m
;; define `l` after definition of the macro works:
(setf l '((number 2) (symbol 3)))
;; ((NUMBER 2) (SYMBOL 3))
(m 1 l)
;; 2 ;; so our `eval` can handle definitions of `l` after macro was stated
(m '(1 2) l)
;; NIL
;; even redefining `l` works!
(setf l '((number 2) (symbol 3) (list 4)))
;; ((NUMBER 2) (SYMBOL 3) (LIST 4))
(m 1 l)
;; 2
(m '(1 2) l)
;; 4 ;; and it can handle re-definitions of `l` correctly.
;; however:
(let ((l '((number 2) (symbol 3)))) (m '(1 2) l))
;; 4 !!! this is clearly wrong! Expected is NIL!
;; so our `eval` in the macro cannot handle scoping correctly
;; which is a no-go for usage!
;; but after re-defining `l` globally to:
(setf l '((number 2) (symbol 3)))
;; ((NUMBER 2) (SYMBOL 3))
(m '(1 2) l)
;; NIL ;; it behaves correctly
(let ((lst '((number 2) (symbol 3) (list 4)))) (m '(1 2) lst))
;; *** - EVAL: variable LST has no value
;; so it becomes clear: `m` is looking in the scoping
;; where it was defined - the global scope (the parent scope of `m` when `m` was defined or within the scope of `m`).
So the conclusion is:
The given macro with eval is NOT working correctly!!
Since it cannot handle local scoping.
So #tfb's answer - writing a mini-evaluator-function for l is the probably only way to handle this in a proper, safe, correct way.
Update
It seems to me that doing:
(defmacro m (x l)
`(typecase ,x ,#l))
(defun m-fun (x l)
(eval `(m ,x ,l)))
(m-fun ''y l) ;; 3
(m-fun 'y l) ;; error since y unknown
(let ((l '((number 2) (symbol 3) (list 4))))
(m-fun ''(1 2) l)) ;; => 4 since it is a list
(let ((l '((number 2) (symbol 3))))
(m-fun ''(1 2) l)) ;; => NIL since it is a list
(let ((l '((number 2) (symbol 3))))
(m-fun ''y l)) ;; => 3 since it is a symbol
(let ((n 12))
(m-fun n l)) ;; => 2 since it is a number
;; to improve `m-fun`, one could define
(defun m-fun (x l)
(eval `(m ',x ,l)))
;; then, one has not to do the strangely looking double quote
;; ''y but just one quote 'y.
(let ((l '((number 2) (symbol 3) (list 4))))
(m-fun '(1 2) l)) ;; => 4 since it is a list
;; etc.
at least hides the eval within a function.
And one does not have to use backquote in the main code.
Macro expansion happens at compile time, not run time, thus if the case clause list changes over the course of the program, the macro expansion will not change to reflect it.
If you want to dynamically select an unevaluated but changeable value, you can use assoc in the expansion instead of case:
(defmacro m (x l)
`(second (assoc ,x ,l)))
Sample expansion:
(m x l)
->
(SECOND (ASSOC X L))
Output of (assoc x l) with the value of l in your question and x = 'x:
(let ((x 'x))
(m x l))
->
2
However if you did decide to do it this way, you could simplify things and replace the macro with a function:
(defun m (x l)
(second (assoc x l)))
UPDATE FOR QUESTION EDIT:
Replace assoc as follows:
(defun m (x l)
(second (assoc-if (lambda (type)
(typep x type))
l)))

LISP List Not Appending And Printing Twice

I'm quite new to LISP and I am trying to work on the cond statement for class. Currently, I am attempting to check if the value passed is a list and if so, append the letter d onto the list.
Here is my code:
(defun test(L)
(listp L)
(cond ((listp L) (append L (list 'd)))
)
(write L)
)
(test (list 'a 'b 'c))
The output I get is:
(A B C)
(A B C)
If I change the test to: (test (car(list 'a 'b 'c)))
The new output I get is:
A
A
Two things I am wondering is
1.) Why isn't D appended onto the list if the first test passes a list?
2.) Why are they being printed twice? I'm using LISP Works so I figure it's actually something with how it always outputs the final value or something.
1.) The same reason str + "d" doesn't mutate str in Java or Python. It creates a new list that you do not use!
>>> str + "d"
'abcd'
>>> str
'abc'
Crazy similar isn't it?
2.) In CL the return is the last evaluated expression. The REPL prints every top level expression result to the terminal. Python does this too:
>>> def test():
... x = 2 + 3
... print x
... return x
...
>>> test()
5
5
Update
How to mutate the argument list. The simple answer is that you need to mutate the last pair of the argument instead:
(defun test (l)
(assert (consp 1) (l) "l needs to be a non nil list. Got: ~a" l)
(nconc l (list 'd)
(write l)))
(defparameter *test1* (list 1 2 3))
(defparameter *test1-copy* *test1*)
(test *test1*) ; ==> (1 2 3 d) (and prints (1 2 3 d))
*test1* ; ==> (1 2 3 d)
*test1-copy* ; ==> (1 2 3 d)
(eq *test1* *test1-copy*) ; ==> t
(test '())
** error l needs to be a non nil list. Got: NIL
(nconc l x) does (setf (cdr (last l)) x)
If you need to alter the binding, then you need to make a macro:
(defmacro testm (var)
(assert (symbolp var) (var) "List needs to be a variable binding. Got: ~a" var)
`(progn
(when (listp ,var)
(setf ,var (append ,var (list 'd)))
(write ,var))))
(macroexpand '(testm *test2*))
; ==> (progn
; (when (consp *test2*)
; (setf *test2* (append *test2* (list 'd))))
; (write *test2*))
(defparameter *test2* (list 1 2 3))
(defparameter *test2-copy* *test2*)
(testm *test2*) ; ==> (1 2 3 d) (and prints (1 2 3 d))
*test2* ; ==> (1 2 3 d)
*test2-copy* ; ==> (1 2 3)
(eq *test2* *test2-copy*) ; ==> nil
(defparameter *x* nil)
(testm *x*) ; ==> (d) (and prints (d))
*x* ; ==> (d)
(testm '(1))
** error List needs to be a variable binding. Got: '(1)
Idiomatic way to do it
(defun test (list)
(if (consp list)
(append list '(d))
list))
(write (test '(1 2 3)))
; ==> (1 2 3 d) (and prints (1 2 3 d))
(defparameter *test3* '(1 2 3))
(setf *test3* (test *test3*))
*test3* ; ==> (1 2 3 d)

Lisp - if statements various actions

This is my lisp code.
(DEFUN F (A B)
(SETF C (* 4 A))
(SETF D (* 2 (EXPT B 3)))
(SETF RES (+ C D))
(IF (AND (TYPEP A 'INTEGER) (TYPEP B 'INTEGER))
(list 'Final 'value '= res)
'(YOUR INPUTS ARE NOT NUMBERS)))
For example, (f 5 9) works well.
But (f 'w 'q) doesn't work with the following error message:
(ERROR TYPE-ERROR DATUM W EXPECTED-TYPE NUMBER FORMAT-CONTROL
~#<~s' is not of the expected type~s'~:#> FORMAT-ARGUMENTS
(W NUMBER))
Error: W' is not of the expected typeNUMBER'
I want to make if A,B is integer calculate 4A+2B^3.
Else if at least one is not an integer print error message.
I try to the code shown above.
But how can I make this error handling using if statements?
First, you should use LET or LET* to define local variables.
(defun f (a b)
(let* ((c (* 4 a)) ; You need LET* instead of LET because
(d (* 2 (expt b 3))) ; RES depends on the previous variables.
(res (+ c d)))
(if (and (typep a 'integer) (typep b 'integer))
(list 'final 'value '= res)
'(your inputs are not numbers))))
The actual problem is that you're doing the calculations before you check that the arguments are integers. You should move the calculation inside the IF.
(defun f (a b)
(if (and (integerp a) (integerp b))
(let* ((c (* 4 a))
(d (* 2 (expt b 3)))
(res (+ c d)))
(list 'final 'value '= res))
'(your inputs are not numbers)))
Returning lists like that is kind of strange. If you intend them as output for the user, you should instead print the messages and return the actual result.
(defun f (a b)
(if (and (integerp a) (integerp b))
(let ((result (+ (* 4 a)
(* 2 (expt b 3)))))
(format t "Final value = ~a~%" result)
result) ; Return RESULT or
(format t "Your inputs are not integers.~%"))) ; NIL from FORMAT.
In most cases you should signal an error if the arguments are not correct type. Printing output from a function that does the calculation is usually a bad idea.
(defun f (a b)
(check-type a integer "an integer")
(check-type b integer "an integer")
(+ (* 4 a)
(* 2 (expt b 3))))
(defun main (a b)
(handler-case
(format t "Final value = ~a~%" (f a b))
;; CHECK-TYPE signals a TYPE-ERROR if the type is not correct.
(type-error () (warn "Your inputs are not integers."))))
(main 12 1)
; Final value = 50
;=> NIL
(main 12 'x)
; WARNING: Your inputs are not integers.
;=> NIL
Common Lisp condition system also allows you to use restarts to fix errors. CHECK-TYPE establishes a restart named STORE-VALUE, which you can invoke to supply a correct value for the place. In this case it probably doesn't make sense, but you could do something like use 1 as a default.
(defun main (a b)
(handler-bind ((type-error (lambda (e)
(store-value 1 e))))
(format t "Final value = ~a~%" (f a b))))
(main 12 1)
; Final value = 50
;=> NIL
(main 12 'x)
; Final value = 50
;=> NIL
Notice that conditions/error handlers do add some overhead, so for performance critical functions you might not want to use them and instead check your arguments before calling the function.
(declaim (ftype (function (integer integer) integer) f))
(defun f (a b)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(+ (* 4 a)
(* 2 (expt b 3))))
(defun main (a b)
(if (and (integerp a)
(integerp b))
(format t "Final value = ~a~%" (f a b))
(warn "Your inputs are not integers.")))

returning the best element from the list L according to function F?

i am trying to write a function in lisp which have 2 parameters one function F and one list L
if i place '> in place of F and list L is '(1 2 3 4 5) it will return 5 as 5 is biggest.
and if we put '< then it compares all list elements and gives the smallest one as output.
and so on.
we can even put custom written function in place of F for comparison.
i wish i could provide more sample code but i am really stuck at the start.
(DEFUN givex (F L)
(cond
(F (car L) (car (cdr L))
;after this i got stuck
)
)
another attemp to write this function
(defun best(F list)
(if (null (rest list)) (first list)
(funcall F (first List) (best (F list)))))
You are almost there, just the else clause returns the f's return value instead of the the best element:
(defun best (F list)
(let ((first (first list))
(rest (rest list)))
(if (null rest)
first
(let ((best (best f rest)))
(if (funcall F first best)
best
first)))))
Examples:
(best #'< '(1 2 3))
==> 3
(best #'> '(1 2 3))
==> 1
Note that this recursive implementation is not tail-recursive, so it is not the most efficient one. You might prefer this instead:
(defun best (f list)
(reduce (lambda (a b) (if (funcall f a b) b a)) list))
Or, better yet,
(defmacro fmax (f)
`(lambda (a b) (if (,f a b) b a)))
(reduce (fmax <) '(1 2 3))
==> 1
(reduce (fmax >) '(1 -2 3 -4) :key #'abs)
==> 1
(reduce (fmax <) '(1 -2 3 -4) :key #'abs)
==> 4

Is there a common lisp macro for popping the nth element from a list?

I'm pretty fresh to the Common Lisp scene and I can't seem to find an quick way to get the nth element from a list and remove it from said list at the same time. I've done it, but it ain't pretty, what I'd really like is something like "pop" but took a second parameter:
(setf x '(a b c d))
(setf y (popnth 2 x))
; x is '(a b d)
; y is 'c
I'm pretty sure that "popnth" would have to be a macro, in case the parameter was 0 and it had to behave like "pop".
EDIT: Here's my crap first version:
(defmacro popnth (n lst)
(let ((tempvar (gensym)))
`(if (eql ,n 0)
(pop ,lst)
(let ((,tempvar (nth ,n ,lst)))
(setf (cdr (nthcdr ,(- n 1) ,lst)) (nthcdr ,(+ n 1) ,lst))
,tempvar))))
Something like this:
Removing the nth element of a list:
(defun remove-nth (list n)
(remove-if (constantly t) list :start n :end (1+ n)))
constantly returns a function, that always returns its argument.
As a macro that accepts a place, using define-modify-macro:
(define-modify-macro remove-nth-f (n) remove-nth "Remove the nth element")
POP-NTH
(defmacro pop-nth (list n)
(let ((n-var (gensym)))
`(let ((,n-var ,n))
(prog1 (nth ,n-var ,list)
(remove-nth-f ,list ,n-var)))))
Example:
CL-USER 26 > (defparameter *list* (list 1 2 3 4))
*LIST*
CL-USER 27 > (pop-nth *list* 0)
1
CL-USER 28 > *list*
(2 3 4)
CL-USER 29 > (pop-nth *list* 2)
4
CL-USER 30 > *list*
(2 3)
Yes, Lisp has a macro for popping the N-th element of a list: it is called pop.
$ clisp -q
[1]> (defvar list (list 0 1 2 3 4 5))
LIST
[2]> (pop (cdddr list))
3
[3]> list
(0 1 2 4 5)
[4]>
pop works with any form that denotes a place.
The problem is that, unlike cddr, nthcdr isn't an accessor; a form like (nthcdr 3 list) does not denote a place; it works only as a function call.
Writing a specialized form of pop is not the best answer; rather, we can achieve a more general fix by writing a clone of nthcdr which behaves like a place accessor. Then the pop macro will work, and so will every other macro that works with places like setf and rotatef.
;; our clone of nthcdr called cdnth
(defun cdnth (idx list)
(nthcdr idx list))
;; support for (cdnth <idx> <list>) as an assignable place
(define-setf-expander cdnth (idx list &environment env)
(multiple-value-bind (dummies vals newval setter getter)
(get-setf-expansion list env)
(let ((store (gensym))
(idx-temp (gensym)))
(values dummies
vals
`(,store)
`(let ((,idx-temp ,idx))
(progn
(if (zerop ,idx-temp)
(progn (setf ,getter ,store))
(progn (rplacd (nthcdr (1- ,idx-temp) ,getter) ,store)))
,store))
`(nthcdr ,idx ,getter)))))
Test:
$ clisp -q -i cdnth.lisp
;; Loading file cdnth.lisp ...
;; Loaded file cdnth.lisp
[1]> (defvar list (list 0 1 2 3 4 5))
LIST
[2]> (pop (cdnth 2 list))
2
[3]> list
(0 1 3 4 5)
[4]> (pop (cdnth 0 list))
0
[5]> list
(1 3 4 5)
[6]> (pop (cdnth 3 list))
5
[7]> list
(1 3 4)
[8]> (pop (cdnth 1 list))
3
[9]> list
(1 4)
[10]> (pop (cdnth 1 list))
4
[11]> list
(1)
[12]> (pop (cdnth 0 list))
1
[13]> list
NIL
[14]>
A possible improvement to the implementation is to analyze the idx form and optimize away the generated code that implements the run-time check on the value of idx. That is to say, if idx is a constant expression, there is no need to emit the code which tests whether idx is zero. The appropriate code variant can just be emitted. Not only that, but for small values of idx, the code can emit special variants based on the "cadavers": cddr, cdddr, rather than the general nthcdr. However, some of these optimizations might be done by the Lisp compiler and thus redundant.
I came up with a solution that is a little more efficient than my first attempt:
(defmacro popnth (n lst)
(let ((t1 (gensym))(t2 (gensym)))
`(if (eql ,n 0)
(pop ,lst)
(let* ((,t1 (nthcdr (- ,n 1) ,lst))
(,t2 (car (cdr ,t1))))
(setf (cdr ,t1) (cddr ,t1))
,t2))))
Here is it in action:
[2]> (defparameter *list* '(a b c d e f g))
*LIST*
[3]> (popnth 3 *list*)
D
[4]> *list*
(A B C E F G)
[5]> (popnth 0 *list*)
A
[6]> *list*
(B C E F G)
I have same suspicion as #6502...If I remember right...Neither push nor pop can be defined as modify-macros, the former because the place is not its first argument, and the latter because its return value is not the modified object.
Definition of define-modify-macro
An expression of the form (define-modify-macro m (p1 ... pn) f) defines a new macro m, such that a call of the form (m place a1 ... an) will cause place to be set to (f val a1 ... an), where val represents the value of place. The parameters may also include rest and optional parameters. The string, if present, becomes the documentation of the new macro.
I have this popnth works just fine:
(defun nthpop (index lst)
(pop (nthcdr (1- index) lst)))
> *list*
(1 2 3 4 5)
> (nthpop 2 *list*)
2
> *list*
(1 3 4 5)