I need to write a recursive helper function and do not need to give it global scope, but I need to reference it to achieve the recursion.
Emacs lisp has fset, which assigns to the function-cell of a symbol. What is the equivalent in common lisp?
I just found out that this is a idion common enough to be in alexandria. From alexandria code:
(defmacro named-lambda (name lambda-list &body body)
"Expands into a lambda-expression within whose BODY NAME denotes the corresponding function."
`(labels ((,name ,lambda-list ,#body))
#',name))
Here's an usage exmaple:
(let ((! ;; Everything can be a symbol :D
;; Definition here
(named-lambda self (n)
(case n
(1 1)
(otherwise (* n
(self (1- n)))))))) ;; Recurse here
;; How to call it
(funcall ! 6))
What malisper said.
Or if you really need a named lambda:
(defmacro named-lambda (name args &body body)
`(labels ((,name ,args ,#body))
#',name))
Related
I want some reader macros to print as as shortened expression that the macro understands. Lets say I want to extend the #' macro to take #'~[rest-of-symbol] and turn that into (complement #'rest-of-symbol).
What controls how that is printed? On SBCL, for instance, '(function +) prints as #'+. How do i make '(complement #'listp) print as #~listp?
My first thought was
(defmethod print-object :around ((obj cons) stream)
;; if #'~fn-name / (complement (function fn-name))
;; => fn-name otherwise NIL
(let ((fn-name
(ignore-errors
(destructuring-bind (complement (function fn-name))
obj
(when (and (eq complement 'complement)
(eq function 'function))
fn-name)))))
(if fn-name
(format stream "#'~~~S" fn-name)
(call-next-method))))
This works insofar as (print-object '(complement #'evenp) *standard-output*) prints it the way I want, but the REPL doesn't. Also (print-object '#'+ *standard-output*) prints it as (function +) so the REPL isn't using print-object. With defining the print-object method for user defined classes the REPL always picks up on the new definition.
This is my first post and I'm sorry I can't get the code to format properly. If someone can put a link on how to do that I would appreciate it.
Evaluation time
You are mixing code with data in your example:
(function +)
Is a special form that evaluates to a function object, which admits a shorter syntax:
#'+
But when you are writing:
'(function +)
or
'(complement fn)
Then in both cases you are writing quoted, literal lists, which evaluates to themselves (namely a list starting with symbol function or complement, followed respectively by symbol + and fn).
However, you want the code to be evaluated at runtime to actual function objects; if you type this in the REPL:
(complement #'alpha-char-p)
The result is a value that is printed as follows:
#<FUNCTION (LAMBDA (&REST SB-IMPL::ARGUMENTS) :IN COMPLEMENT) {101AAC8D9B}>
You have an actual function object that you can funcall. In other words, by the time you reach print-object, you no longer have access to source code, you are manipulating data at runtime which happens to be functions. So you cannot use destructuring-bind to get the complement symbol that was present in the source code.
What you need to do instead is to attach metadata to your function. There is a way to do that in Common Lisp by defining a new type of function, thanks to the Meta-Object Protocol.
Funcallable objects
I'm relying on Closer-MOP for all the symbols prefixed with c2cl: below. I define a new class of functions, annotated-fn, which is a function with addditional data:
(defclass annotated-fn (c2cl:funcallable-standard-object)
((data :initform :data :initarg :data :reader annotated-fn-data))
(:metaclass c2cl:funcallable-standard-class))
Notice that this class is a funcallable-standard-object (like the usual functions), and its metaclass is funcallable-standard-class. Such an object has an additional implicit slot that is a function to call.
More precisely, you have to call c2cl:set-funcallable-instance-function to set a function associated with the object, and when later you use funcall or apply with the object, then the wrapped function is called instead. So you can transparently use this class of functions wherever you usually use a function. It just has additional slots (here data).
For example, here is how I instantiate it, with a function to wrap additional data:
(defun annotate-fn (function data)
(let ((object (make-instance 'annotated-fn :data data)))
(prog1 object
(c2cl:set-funcallable-instance-function object function))))
Let's try it:
(describe
(annotate-fn (constantly 3)
'(:category :constantly)))
#<ANNOTATED-FN {1006275C7B}>
[funcallable-instance]
Lambda-list: UNKNOWN
Derived type: FUNCTION
Documentation:
T
Source file: SYS:SRC;CODE;FUNUTILS.LISP
Slots with :INSTANCE allocation:
DATA = (:CATEGORY :CONSTANTLY)
You can also use this object like any other function.
Now, your reader macros can expand into calls to annotate-fn, and add any kind of additional metadata you need to the function.
Reader macro
For our example, imagine you define a reader macros for constant functions:
(set-macro-character #\[ 'read-constantly t)
(set-macro-character #\] (get-macro-character #\) nil))
(defun read-constantly (stream char)
(declare (ignore char))
(let* ((list (read-delimited-list #\] stream t))
(value (if (rest list) list (first list)))
(var (gensym)))
`(let ((,var ,value))
(annotate-fn (constantly ,var)
(list :category :constantly
:constant ,var)))))
Using this syntax:
> [(+ 8 5)]
=> #<ANNOTATED-FN ...>
By the way, the syntax I defined also allows the following:
> [+ 8 5]
Pretty-printing
Let's define a generic function that prints an annotated function given its :category field:
(defgeneric print-for-category (category data object stream))
(defmethod print-object ((o annotated-fn) s)
(let* ((data (annotated-fn-data o))
(category (getf data :category)))
(print-for-category category data o s)))
Then, we can specialize it for :constantly, and here we assume also that the data associated with the function contains a :constant field:
(defmethod print-for-category ((_ (eql :constantly)) data o s)
(format s "[~s]" (getf data :constant)))
For example:
(let ((value (+ 8 6)))
(annotate-fn (constantly value)
`(:constant ,value
:category :constantly)))
This above is printed as:
[14]
Which would be the same as your hypothetical reader macro.
To do this you need to understand the pretty printer. I have understood it in the past but no longer do completely. It dispatches on type and the trick for things like this is that you can specify very specific types for trees of conses, although doing so is verbose.
Here is an example which is almost certainly not completely correct, but does achieve what you want in this case:
(defparameter *ppd* (copy-pprint-dispatch))
(defun pprint-complement-function (s form)
;; This is the thing that the pretty printer will call. It can
;; assume that the form it wants to print is already correct.
(destructuring-bind (complement (function name)) form
(declare (ignore complement function))
(format s "#'~~~W" name)))
;;; Now set this in the table with a suitable hairy type specification
;;;
(set-pprint-dispatch '(cons (eql complement)
(cons (cons (eql function)
(cons t null))
null))
'pprint-complement-function
0
*ppd*)
And now
> (let ((*print-pprint-dispatch* *ppd*))
(pprint '(complement (function foo)))
(pprint '((complement (function foo)) (function foo))))
#'~foo
(#'~foo #'foo)
You can make the awful nested cons type specifier easier by defining this (which, perhaps, should be the compound type specifier for list except you can't do that):
(deftype list-of-types (&rest types)
(labels ((lot (tt)
(if (null tt)
'null
`(cons ,(first tt) ,(lot (rest tt))))))
(lot types)))
And then
(set-pprint-dispatch '(list-of-types (eql complement)
(list-of-types (eql function)
*))
'pprint-complement-function
0
*ppd*)
is perhaps easier to read.
I am using the defclass macro from Practical Common Lisp, which takes as argument a list of symbols.
I would like to change the macro in order to let it accept a quoted list of symbols. This has the benefit of having thenm defined as constants that can be used in other convenience functions, e.g. here. I confused myself in trying to get this done.
My use case is following:
(defconstant state-slots '(unit motion mode moc-offset woc-pos woc-inc feed spindle))
;; would like to use the quoted list here:
(defclass-by-slots gc-state (unit ; :mm(=G21) :inch(=G20)
motor ; nil :on
motion ; :jog(=G0) :lin(=G1) :cw(=G2) :ccw(=G3)
mode ; :abs(=G90) :inc(=G91)
moc-offset ; woc-zero(xyz, mm) from moc-zero
woc-pos ; woc-pos(xyz, mm) from woc-zero
woc-inc
feed
spindle))
;; can use quoted slot list when using a convenience function, e.g:
(defun format-by-slots (o slots &optional str-type)
(let* ((f (lambda (s$) (eval (format-slot o s$))))
(str-type (string-upcase str-type))
(r (concatenate
'string
(format nil "~A (~A)" o (class-of o))
(reduce (lambda (s1 s2) (concatenate 'string s1 s2))
(loop for s in slots
when (funcall f s) collect it)
:from-end t :initial-value (format nil "~%")))))
(if str-type
(ppcre:regex-replace-all
(format nil "^#<~A \\{(\\d|[A-F])+\\}> " str-type)
r
(format nil "#<~A {...}> " str-type))
r)))
I am using this for several classes defined by different slots.
The nuisance is that I cannot have defined the slots uniformly for the type definition and the convenience functions which is source of annoying errors.
Solution based on [Rainer Joswig's answer] (https://stackoverflow.com/a/61154538/2336738):
(defmacro def-my-class (name supers slots-symbol)
"The value of a symbol of slots-symbol is used as the
list of slots."
`(defclass ,name ,supers
,(if (and (symbolp slots-symbol)
(symbol-value slots-symbol)
(listp (symbol-value slots-symbol)))
(mapcar #'slot->defclass-slot (symbol-value slots-symbol))
(error "~a is not a symbol which names a list of slot names" slots-symbol))))
Symbol values at compile time
If you want to use the value of a symbol at compile time, then you need to make sure that it is defined. Two usual ways to do that:
define the symbol in a file and load it before compiling another file where it is used
use EVAL-WHEN to execute a symbol definition (defvar, defparameter,defconstant` ...) at compile time
Read-time evaluation
One possibility to use a symbol value during compilation is to use read-time evaluation. You would need to make sure that the constant value of +state-slots+ is defined during compilation:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +state-slots+
'(unit motion mode moc-offset woc-pos woc-inc feed spindle)))
(defclass foo ()
#.+state-slots+)
Custom Macro
If the value of +state-slots+ is defined at compile time, then we can also use it in a macro:
(defmacro def-my-class (name supers slots-symbol)
"The value of a symbol of slots-symbol is used as the
list of slots."
`(defclass ,name ,supers
,(if (and (symbolp slots-symbol)
(symbol-value slots-symbol)
(listp (symbol-value slots-symbol)))
(symbol-value slots-symbol)
(error "~a is not a symbol which names a list of slot names"))))
(def-my-class foo () +state-slots+)
Most of the functions I write are really small and relatively few of them are recursive. Does Common Lisp provide a way to prevent recursion by "unbinding" the name of the function inside its body. Alternatively, does it provide a way to unbind the function value of a symbol so that I can roll my own explicitly non-recursive defun?
I'd like to be able to do something similar to the following, possibly hidden behind a macro.
(defun non-recursive-func (arg)
(unflet (non-recursive-func)
(+ (first arg) (second arg))))
I accidentally wrote some buggy code today where a wrapper function delegated to itself instead of the unwrapped function, and it made me realize that preventing recursion with some compile-time mechanism could be useful.
(defun fcompose-2 (f g)
(lambda (x) (funcall f (funcall g x))
(defun fcompose (&rest args)
(reduce #'fcompose-2 args))
Except that I had accidentally written the following for definition for fcompose.
(defun fcompose (&rest args)
(reduce #'fcompose args))
naturally leading to a stack overflow.
How about:
(defmacro defun* (name (&rest args) &body body)
`(defun ,name ,args
(flet ((,name ,args
(declare (ignore ,#args))
(error "~a is defined with defun* and cannot be called from itself" ',name)))
,#body)))
This adds a internal binding in the function scope that just signals an error if it is used in the body and you can replace defun* definition with defun for production.
According to the CLHS, FUNCALL argument is a function designator, which can be a symbol denoting a function defined in the global environment. I am looking for a way to do this locally, like in this example:
(defun test ()
(let ((name 'local-function))
(flet ((local-function ()
'hello))
(funcall name))))
I am looking for a way to get the function definition from the local environment. Is it possible with Common Lisp?
If you're just trying to call a local function using funcall, note that a function designator can also be the function object, and you can get that by using the (function name) == #'name notation. I.e., you can do:
(defun test ()
(flet ((local-function ()
'hello))
(funcall #'local-function)))
You can return this value, too, and so let the local function “escape” outside. E.g., you could implement a counter:
(defun make-counter (init)
(flet ((counter ()
(incf init)))
#'counter))
; This case is simple, and could have been:
;
; (defun make-counter (init)
; (lambda ()
; (incf init)))
(let ((counter (make-counter 3)))
(list (funcall counter)
(funcall counter)
(funcall counter)))
;=> (4 5 6)
As uselpa pointed out though, you won't be able to get the function object via a symbol, much in the same way that there's no association at runtime between the symbol named "X" and the lexical variable x in
(let ((x 'foo))
x)
The lexical variables don't have any association at run time with the symbols that named them in the source code.
According to this, no. It doesn't work with eval either. I suppose that at run-time there is no trace left of the local function's name.
Also, my understanding is that if the function designator is a symbol, then symbol-function is used, which is not defined for local functions.
In Common Lisp, is it possible to redefine an already defined function within a certain scope? For example, given a function A that calls a function B. Can I temporarily redefine B during a call to A?
I'm looking for something along the lines of a let block, but that can redefine functions.
Within a given lexical scope, yes. Use FLET or LABELS. Any function defined with FLET will be unable to call functions defined in the same lexical scope, if you want that (for, say, self-recursive of a group of mutually recursive functions), you will need to use LABELS.
Note that both FLET and LABELS only establish lexical shadowing, should not be used to shadow functions from the COMMON-LISP package and will not dynamically change what function is called from outside the lexical scope the form establishes.
Local functions can be introduced with FLET and LABELS.
If you want to redefine/shadow an existing function using dynamic scope, this is a macro I've been using for a while.
(defmacro! with-shadow ((fname fun) &body body)
"Shadow the function named fname with fun
Any call to fname within body will use fun, instead of the default function for fname.
This macro is intentionally unhygienic:
fun-orig is the anaphor, and can be used in body to access the shadowed function"
`(let ((fun-orig))
(cond ((fboundp ',fname)
(setf fun-orig (symbol-function ',fname))
(setf (symbol-function ',fname) ,fun)
(unwind-protect (progn ,#body)
(setf (symbol-function ',fname) fun-orig)))
(t
(setf (symbol-function ',fname) ,fun)
(unwind-protect (progn ,#body)
(fmakunbound ',fname))))))
Usage:
Clozure Common Lisp Version 1.9-r15759 (DarwinX8664) Port: 4005 Pid: 4728
; SWANK 2012-03-06
CL-USER>
(defun print-using-another-fname (x)
(print x))
PRINT-USING-ANOTHER-FNAME
CL-USER>
(let ((*warn-if-redefine-kernel* nil))
(with-shadow (print (lambda (x)
(funcall fun-orig (+ x 5))))
(print-using-another-fname 10)))
15
15
CL-USER>
(print 10)
10
10
CL-USER>
Note that it relies on Doug Hoyte's defmacro! macro, available in Let Over Lambda.
Also as written, it's anaphoric (fun-orig is available within the body). If you want it completely hygienic, just change the fun-orig's to ,g!fun-orig's.
I most often redefine functions when writing unit tests. Mocking functions within the scope of a particular unit test is helpful, and sometimes that needs to be done with dynamic (not lexical) scope.
You can simulate dynamic-binding for funs like this:
(defmacro setvfun (symbol function)
`(progn
(setf ,symbol ,function)
(setf (symbol-function ',symbol) (lambda (&rest args) (apply (symbol-value ',symbol) args)))))
and then ,for example, with
(setvfun some-fun (lambda() (format t "initial-definition~%")))
(defun test-the-fun (&rest args) (apply #'some-fun args))
(defun test ()
(test-the-fun)
(flet ((some-fun () (format t "Lexically REDEFINED (if you see this, something is very wrong)~%")))
(test-the-fun))
(let ((some-fun (lambda (x) (format t "Dynamically REDEFINED with args: ~a~%" x))))
(declare (special some-fun))
(test-the-fun "Hello"))
(test-the-fun))
you get:
REPL> (test)
==>initial-definition
==>initial-definition
==>Dynamically REDEFINED with args: Hello
==>initial-definition