Write a function that behaves like car, cadr, caddr etc - common-lisp

I'm new to lisp (i'm experimenting with sbcl and ccl), i came across the use of car and cdr that can be chained arbitrarily within a single function call like (caddr).
I was wandering how one would write functions that behave like this...
Say for example i'd like my-eval to eval the input s-exp 3 times if i invoke it like (my-evaaal '(+ 2 1))
I've hacked my way around with a macro like
(my-ev $$$$ '(...)) where the behavior is dictated by the number of '$' in the first argument by transforming it into char sequence (coerce (symbol-name x) 'list) and the evaluate and recurse until the list is nil...
basic need:
;; if
(defvar *foo* 1)
(eval '*foo*) ;; => 1
(eval ''*foo*) ;; => *foo*
(eval '''*foo*) ;; => '*foo*
;; then
(eval (eval (eval '''*foo*))) ;; => 1
desired syntax
(my-eval '''*foo*) ;; => '*foo*
(my-evaal '''*foo*) ;; => *foo*
(my-evaaal '''foo) ;; => 1

Functions like CAAR, CADR are just regular functions; you can define a macro to help you define them easily if you want to.
 Macros
(defpackage :so (:use :cl :ppcre))
(in-package :so)
(defmacro eval%% (count form)
(case count
(0 form)
(1 `(eval ,form))
(t (check-type count (integer 2))
`(eval%% ,(1- count) (eval ,form)))))
For example, the following :
(eval%% 3 '''most-positive-fixnum)
expands successively as:
(EVAL%% 2 (EVAL '''MOST-POSITIVE-FIXNUM))
(EVAL%% 1 (EVAL (EVAL '''MOST-POSITIVE-FIXNUM)))
(EVAL (EVAL (EVAL '''MOST-POSITIVE-FIXNUM)))
Then, you can define custom eval functions as follows, or even with another macro:
(defun evaal (x) (eval%% 2 x))
(defun evaaal (x) (eval%% 3 x))
Handler and restarts
Alternatively, note that you can catch calls to undefined functions:
(block nil
(handler-bind ((undefined-function
(lambda (e)
(return
(values (cell-error-name e)
(compute-restarts e))))))
(evaaaaaal 'a)))
=> EVAAAAAAL
(#<RESTART CONTINUE {7FD5F5F8CE43}> #<RESTART USE-VALUE {7FD5F5F8CE03}>
#<RESTART SB-KERNEL::RETURN-VALUE {7FD5F5F8CDC3}>
#<RESTART SB-KERNEL::RETURN-NOTHING {7FD5F5F8CD83}>
#<RESTART SWANK::RETRY {7FD5F5F8DA13}> #<RESTART ABORT {7FD5F5F8DEC3}>
#<RESTART ABORT {7FD5F5F8EB03}>)
You can also use the standard USE-VALUE restart to provide a different function to call:
(defun multi-eval-handler (condition)
(let ((name (cell-error-name condition)))
(when (eq (symbol-package name) (find-package :so))
(register-groups-bind ((#'length count)) ("EV\(A+\)L" (string name))
(invoke-restart 'use-value (make-repeated-evaluator count))))))
You need an auxiliary function that computes an evaluation N times:
(defun make-repeated-evaluator (count)
(case count
(0 #'identity)
(1 #'eval)
(t (check-type count (integer 2))
(lambda (form)
(loop
for value = form then (eval value)
repeat count
finally (return value))))))
For example:
(funcall (make-repeated-evaluator 3)
'''most-positive-fixnum)
=> 4611686018427387903
And then, you can have arbitrarily long eval functions:
(handler-bind ((undefined-function #'multi-eval-handler))
(evaaaaaaaaaaaaaal '''''''''''''0))
Now, if you compile the code, you'll have warnings at compile-time about the unknown function, when then you can muffle warnings.

Related

In Common Lisp, how to use lexical scope and funcall to make another function be passed as an argument?

I am using SBCL, Emacs, and Slime. Hence, I can do:
CL-USER> (defvar example #'(lambda (x) (* x 20)))
EXAMPLE
CL-USER> (funcall example 10)
200
Ok. It works as expected. Using the library Dexador, I can also so:
CL-USER> (ql:quickload :dexador)
To load "dexador":
Load 1 ASDF system:
dexador
; Loading "dexador"
.......
(:DEXADOR)
CL-USER> (dex:get "http://www.paulgraham.com")
"big HTML ommited"
200
#<HASH-TABLE :TEST EQUAL :COUNT 11 {10029F1443}>
#<QURI.URI.HTTP:URI-HTTP http://www.paulgraham.com>
#<SB-SYS:FD-STREAM for "socket 10.0.0.193:44936, peer: 74.6.52.135:80" {1002681F73}>
Now, I am trying to make the argument to be passed be a function! More specifically, the dex:get function. I tried different approaches, but none of them worked out:
CL-USER> (defvar example-failing #'(lambda (x) (x "http://www.paulgraham.com")))
; in: DEFVAR EXAMPLE-FAILING
; (LAMBDA (X) (X "http://www.paulgraham.com"))
;
; caught STYLE-WARNING:
; The variable X is defined but never used.
; in: DEFVAR EXAMPLE-FAILING
; (X "http://www.paulgraham.com")
;
; caught STYLE-WARNING:
; undefined function: COMMON-LISP-USER::X
;
; compilation unit finished
; Undefined function:
; X
; caught 2 STYLE-WARNING conditions
EXAMPLE-FAILING
CL-USER> (funcall example-failing dex:get)
; Evaluation aborted on #<UNBOUND-VARIABLE GET {1002C57103}>.
CL-USER> (funcall example-failing 'dex:get)
; Evaluation aborted on #<UNDEFINED-FUNCTION X {1002DEA263}>.
CL-USER> (funcall example-failing #'dex:get)
; Evaluation aborted on #<UNDEFINED-FUNCTION X {1002F906C3}>.
CL-USER> (funcall example-failing (function dex:get))
; Evaluation aborted on #<UNDEFINED-FUNCTION X {1003147F83}>.
I managed to do it with:
CL-USER> (defvar hacky-eval #'(lambda (x) (eval x)))
HACKY-EVAL
CL-USER> (funcall hacky-eval (dex:get "http://www.paulgraham.com"))
"big html omitted"
But, this feels as bad practice. Is there another way to fix this?
Thanks
I am confused by your question although not as confused as you seem to be. You already seem to know that, to call a function which is the value of a variable, you need either
funcall if you have all the arguments as individual things;
apply if you have only a list of arguments;
and that to get the function value of something you need (function thing) or equivalently #'thing[1].
But then you forget that in your function, and pay no attention to the copious warnings from SBCL.
So
(defvar *example* (lambda (f) (funcall f "http://www.paulgraham.com")))
...
(funcall *example* #'dex:get)
Note that none of this (and nothing in your question) relies on lexical scope: this would all have worked in any historical Lisp.
[1]: you don't need #' for (lambda ...) only because lambda is a macro which expands into (function (lambda ...)). Very old code sometimes uses the explicit #'(lambda ...) form since this macro did not always exist in CL.
Your code:
(defvar example-failing
#'(lambda (x)
(x "http://www.paulgraham.com")))
This makes no sense in Common Lisp. x is a variable. You can't use a variable as a function as in (x arg). In Common Lisp there are different namespaces for functions and variables. For example LET introduces a local variable and FLET introduces a local function.
The ways to call a function bound to a variable are:
(funcall x arg)
(apply x (list arg))
Thus correct examples would be:
(defvar example-failing
#'(lambda (x)
(apply x (list "http://www.paulgraham.com"))))
or
(defvar example-failing
#'(lambda (x)
(funcall x "http://www.paulgraham.com")))
Your solution is no solution
This is your example:
CL-USER> (defvar hacky-eval #'(lambda (x) (eval x)))
HACKY-EVAL
CL-USER> (funcall hacky-eval (dex:get "http://www.paulgraham.com"))
"big html omitted"
This does not work as you think.
(funcall hacky-eval (dex:get "http://www.paulgraham.com"))
is just the same as
(funcall hacky-eval "big html omitted")
and then
(eval "big html omitted")
and then
"big html omitted"
All your call to eval does is to evaluate a string to itself.
You really need to understand basic evaluation rules in Lisp:
(defun foo (arg)
(eval arg))
(foo (+ 3 4))
is simply the same as:
(defun foo (arg)
arg)
(foo (+ 3 4))
which is the same as
(identity (+ 3 4))
Note: if you pass just self evaluating data to EVAL, then all it does is to return the data
A function call (foo (+ 1 2)) works like this:
Lisp sees that FOO is a function
Lisp evaluates the arguments. (+ 1 2) -> 3
Lisp calls the function FOO with the evaluated argument: (funcall #'foo 3)
Lisp computes the function FOO: (EVAL 3) -> 3
Lisp returns the value(s) from FOO -> 3
Start by using a proper defun:
(defun request (url)
(dex:get url))
CL-USER> (request "http://…")
Now you want to use something else than dex:get? Well… write another function, because their argument handling, headers, return values… might be different.
(defun request-drakma (url)
(drakma:… url))
Maybe in later code you want to reference to either function?
(defun do-request (url &optional (get-fn #'request))
(funcall get-fn url))
(defvar example #'(lambda (x) (* x 20)))
Here you are giving a name to an anonymous function… just use defun^^

Common lisp macro not calling function

I am working on a complicated macro and have run into a roadblock.
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o
(with-hash-table-iterator (next-entry ,on)
(destructuring-bind
,(apply #'append vars)
(let ((current-band (list ,#(mapcar #'not (apply #'append vars)))))
(for (i 1 ,(length (apply #'append vars)) 2)
(multiple-value-bind
(succ k v) (next-entry)
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
im getting "Evaluation aborted on #<UNDEFINED-FUNCTION NEXT-ENTRY {100229C693}>"
i dont understand why next-entry appears to be invisible to the macro i have created.
I've tried stripping down this to a small replicable example but i couldnt find a minimal scenario without the macro i created where next-entry would be invisible besides this scenario no matter what I tried, i've always managed to find a way to call next-entry in my other examples so im stumped as to why i cannot get it working here
I've tested the for macro ive created and it seems to generally work in most cases but for some reason it cannot see this next-entry variable. How do i make it visible?
In your code there are multiple places where the macro generates bindings in a way that is subject to variable capture (pdf).
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o ;; VARIABLE CAPTURE
(with-hash-table-iterator (next-entry ,on) ;; VARIABLE CAPTURE
(destructuring-bind ,(apply #'append vars)
(let ((current-band ;;; VARIABLE CAPTURE
(list ,#(mapcar #'not (apply #'append vars)))))
(for
(i ;;; VARIABLE CAPTURE
1 ,(length (apply #'append vars)) 2)
(multiple-value-bind (succ k v) ;;; VARIABLE CAPTURE
,(next-entry) ;;; WRONG EVALUATION TIME
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
A simplified example of such a capture is:
`(let ((x 0)) ,#body)
Here above, the x variable is introduced, but if the code is expanded in a context where xis already bound, then body will not be able to reference that former x binding and will always see x bound to zero (you generally don't want this behavior).
Write a function instead
Instead of writing a big macro for this, let's first try understanding what you want to achieve and write instead a higher-order function, ie. a function that calls user-provided functions.
If I understand correctly, your function iterates over a hash-table by bands of entries. I assume vars holds a list of (key value) pairs of symbols, for example ((k1 v1) (k2 v2)). Then, body works on all the key/value pairs in the band.
In the following code, the function map-each-hashtable-band accepts a function, a hash-table, and instead of vars it accepts a size, the width of the band (the number of pairs).
Notice how in your code, you only have one loop, which builds a band using the hash-table iterator. But then, since the macro is named for-each-hashtable-band, I assume you also want to loop over all the bands. The macro with-hash-table-iterator provides an iterator but does not loop itself. That's why here I have two loops.
(defun map-each-hashtable-band (function hash-table band-size)
(with-hash-table-iterator (next-entry hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(apply function current-band))
(unless next-p
(return-from outer-loop)))))))
For example:
(map-each-hashtable-band (lambda (&rest band) (print `(:band ,band)))
(alexandria:plist-hash-table
'(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5 :g 6))
2)
NB. Iterating over a hash-table happens in an arbitrary order, there is no guarantee that you'll see the entries in any particular kind of order, this is implementation-dependant.
With my current version of SBCL this prints the following:
(:BAND (:A 0 :B 1))
(:BAND (:C 2 :D 3))
(:BAND (:E 4 :F 5))
(:BAND (:G 6))
Wrap the function in a macro
The previous function might not be exactly the behavior you want, so you need to adapt to your needs, but once it does what you want, you can wrap a macro around it.
(defmacro for-each-hashtable-band (vars hash-table &body body)
`(map-each-hashtable-band (lambda ,(apply #'append vars) ,#body)
,hash-table
,(length vars)))
For example:
(let ((test (alexandria:plist-hash-table '(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5))))
(for-each-hashtable-band ((k1 v1) (k2 v2)) test
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2 v2)))
This prints:
A -> 0 && B -> 1
C -> 2 && D -> 3
E -> 4 && F -> 5
Macro-only solution, for completeness
If you want to have only one, single macro, you can start by inlining the body of the above function in the macro, you don't need to use apply anymore, but instead you need to establish bindings around the body, using destructuring-bind as you did. A first draft would be to simply as follows, but notice that this is not a proper solution:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (next-entry ,hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat ,band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(destructuring-bind ,(apply #'append vars) current-band
,#body))
(unless next-p
(return-from outer-loop))))))))
In order to be free of variable capture problems with macros, each temporary variable you introduce must be named after a symbol that cannot exist in any context you expand your code. So instead we first unquote all the variables, making the macro definition fail to compile:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop))))))))
When compiling the macro, the macro is supposed to inject symbols into the code, but here we have a compilation error that says undefined variables:
;; undefined variables: CURRENT-BAND KEY NEXT-ENTRY NEXT-P OUTER-LOOP VALUE
So now, those variables should be fresh symbols:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
(let ((current-band (gensym))
(key (gensym))
(next-entry (gensym))
(next-p (gensym))
(outer-loop (gensym))
(value (gensym)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop)))))))))
This above is a bit verbose, but you could simplify that.
Here is what the previous for-each-hashtable-band example expands into with this new macro:
(with-hash-table-iterator (#:g1576 test)
(loop :named #:g1578
:do (loop :with #:g1575
and #:g1579
and #:g1577
:repeat 2
:do (multiple-value-setq (#:g1577 #:g1575 #:g1579) (#:g1576))
:while #:g1577
:collect #:g1575 into #:g1574
:collect #:g1579 into #:g1574
:finally (progn
(when #:g1574
(destructuring-bind
(k1 v1 k2 v2)
#:g1574
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2
v2)))
(unless #:g1577 (return-from #:g1578))))))
Each time you expand it, the #:gXXXX variables are different, and cannot possibly shadow existing bindings, so for example, the body can use variables named like current-band or value without breaking the expanded code.

Lisp variable using itself in definition

I am building a window application in Lisp using the LTK library. I want a button that does an action and, possibly, hides itself. However, this code:
(let* ((left (button 0 0 f "←" #'(lambda ()
(decf start page-length)
(funcall redraw)
(if (>= start page-length)
(ltk:configure left :state :visible))
(ltk:configure left :state :hidden))))))
claims that "left" is an undefined variable (the rest is defined in code beyond the scope of this problem).
Worst case scenario, I avoid the "button" function I wrote and rework the code for this particular situation, but the scenario begs a general solution. Is there any way in Lisp to use a variable in a function in the definition of the variable?
A let* with only one binding is the same as a let binding. A let binding does not exist until the body is executed. During the execution of button the reference for left must be from an earlier closure or global as left is created after the expression is evaluated. You can do this:
(let ((left nil))
(setf left (button 0 0 f "←" #'(lambda ()
(decf start page-length)
(funcall redraw)
(if (>= start page-length)
(ltk:configure left :state :visible)
(ltk:configure left :state :hidden))))))
NB: There was a bug in the if such that the lambda always would execute (ltk:configure left :state :hidden)
For what it's worth here is a version of letrec in CL:
(defmacro letrec (bindings &body decls/forms)
(assert (and (listp bindings)
(every (lambda (b)
(or (symbolp b)
(and (consp b)
(symbolp (first b))
(null (cddr b)))))
bindings))
(bindings) "malformed bindings")
(multiple-value-bind (names values)
(loop for b in bindings
collect (etypecase b
(symbol b)
(cons (first b)))
into vars
collect (etypecase b
(symbol nil)
(cons (second b)))
into vals
finally (return (values vars vals)))
`(let ,names
(psetf ,#(loop for name in names
for val in values
collect name
collect val))
(locally
,#decls/forms))))
Then
> (letrec ((x (lambda (y)
(if (null y)
'done
(funcall x (cdr y))))))
(funcall x '(1 2 3)))
done

LispWorks program will not build as application

This is my second proper attempt at a Lisp program, as a dice-roller for Mythender (a freely distributed tabletop RPG). It has a couple of problems though:
When it's loaded I get a prompt to confirm creation of the package. Surely this file should be creating it?
When I try to build it standalone with the LispWorks application builder it gives an error saying that I am trying to invoke a CAPI function at compile-time, but I don't see where that is.
I've gotten negative comments from some lisp folks I spoke to about the (the null ()) sections which are meant to indicate a function has no return so no point leaving anything on the stack - is this proper or not? Is there a better way to do it?
Any general suggestions would also be welcome.
(defpackage :mythender (:add-use-defaults t) (:use "CAPI"))
(in-package :mythender)
(defun d6 () (the fixnum (+ 1 (random 6))))
(defun d6s (count)
(declare (type fixnum count))
(the list (loop for x from 1 to count collecting (d6))))
(defun d6over (count threshold)
(declare (type fixnum count threshold))
(the fixnum (count-if
(lambda (x) (> threshold x))
(d6s count))))
(defvar *storm* 3)
(defvar *thunder* 3)
(defvar *lightning* 0)
(declare (ftype (function) printstate))
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(the null ()))
(defun roll ()
(incf *lightning* (d6over *thunder* 3))
(incf *thunder* (d6over *storm* 3))
(the null ()))
(defun damage (threshold)
(setf *thunder* (d6over *thunder* threshold))
(the null ()))
(defun doroll (&rest args)
(roll)
(update-interface)
(the null ()))
(define-interface mythender-interface () ()
(:panes
(roll-button push-button :data "Roll" :callback #'doroll)
(damage-button push-button :data "Damage")
(storm-pane display-pane :title "Storm:" :title-position :left)
(thunder-pane display-pane :title "Thunder:" :title-position :Left)
(lightning-pane display-pane :title "Lightning:" :title-position :left))
(:layouts
(main-layout column-layout '(storm-pane thunder-pane lightning-pane buttonlayout))
(buttonlayout row-layout '(roll-button damage-button))))
(defvar *interface*)
(defun update-interface-slot (slotname value)
(declare (type string slotname) (type fixnum value))
(setf (display-pane-text (slot-value *interface* slotname)) (write-to-string value))
(the null ()))
(defun update-interface ()
(update-interface-slot 'storm-pane *storm*)
(update-interface-slot 'thunder-pane *thunder*)
(update-interface-slot 'lightning-pane *lightning*)
(the null ()))
(defun start ()
(setf *interface* (make-instance 'mythender-interface))
(display *interface*)
(the null (update-interface)))
An answer to your build problem has to wait until you tell us the build statement and the error message.
Your last question:
(declare (ftype (function) printstate))
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(the null ()))
It's known that it is a function. No need to declare that. Declaring types like that, have in plain Common Lisp only the purpose of optimization hints to the compiler, which the compiler may ignore. Only CMUCL (and derived compilers like SBCL and SCL) actually does more with declared types.
Nobody writes such code in Lisp. Better omit the types. Remember: Lisp is not a statically typed language.
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(values))
Using (values) causes the function to not return a value. That's usually preferred, not returning NIL.
If you want to actually check types in a meaningful way at runtime, then make use of ASSERT, CHECK-TYPE and/or DEFMETHOD.
(defun d6s (count)
  (declare (type fixnum count))
  (the list (loop for x from 1 to count collecting (d6))))
Is just:
(defmethod d6s ((n integer))
"Returns a list of n dice rolls."
(loop repeat n collect (d6)))
Don't forget to describe the semantics of your function in human readable form.

In Common Lisp, how to define a generic data type specifier (like list of integers)?

I would like to define a type specifier that describes a list of things of the same type. So I would like to have (list-of integer) similar to (array integer) (which is built-in). I am able to create it for a specific type, like this:
(defun elements-are-integer (seq)
(every #'(lambda (x) (typep x 'integer)) seq))
(deftype list-of-integer ()
'(and list (satisfies elements-are-integer)))
However, this means I have to do this for every possible type. How can I change this code so that the type would take another type as an argument, and construct the satisfies predicate on the fly? The problem is that the satisfies requires a global symbol, and I don't know how to define the predicate function in proper context (I guess I need to gensym it somehow, but how?). Also, the solution should work so that the type could be created inside another package.
Try this:
(defun elements-are-of-type (seq type)
(every #'(lambda (x) (typep x type)) seq))
(deftype list-of-type (type)
(let ((predicate (gensym)))
(setf (symbol-function predicate)
#'(lambda (seq) (elements-are-of-type seq type)) )
`(and list (satisfies ,predicate)) ))
(typep '(1 2 3) '(list-of-type integer))
; -> T
(typep '(1 2 a) '(list-of-type integer))
; -> NIL
(typep '(a b c) '(list-of-type symbol))
; -> T

Resources