I know this is beyond the standard, but is there an official way to get the current function name, in a specific implementation, say SBCL? Sometimes I want to put the current function name in log messages. I believe if there is a consistent way to get the current function name, it makes maintaining the codes easier, at least I don't have to change the log message every time when I change the function name.
Currently I am using a wrapper macro around the defun
(defmacro defun2 (name (&rest args) &body body)
`(defun ,name (,#args)
(let ((fun-name ',name))
,#body)))
(defun2 foo (x y)
(format nil "fun ~a: x is ~a, y is ~a~%"
fun-name x y))
But I am interested to know if there is any easier way.
The hard way
Say you want to add logging to your application, so you define your own little macros and functions, like you would do in another language:
(defpackage :logging (:use :cl))
(in-package :logging)
In order to be able to turn off logging, or to change your implementation as you want, you decide that logging is better encapsulated as a macro:
(defmacro note (&rest things)
`(note% (first (sb-debug:list-backtrace :count 1))
(list ,#things)))
Here above, I'm using sb-debug:list-backtrace to capture the current stack frame. It is not portable and when your function is inline you won't see its name but the name of the caller. But that's an acceptable compromise that every logging library accept in most languages.
Then, you are free to implement that as you want, for example with the condition system:
(define-condition note (simple-warning)
((timestamp
:initarg :timestamp
:reader note-timestamp)
(origin
:initarg :origin
:reader note-origin)
(data
:initarg :data
:reader note-data))
(:report (lambda (c s)
(format s
"~d ~a ~#<~s~:>"
(note-timestamp c)
(note-origin c)
(note-data c)))))
The note% function here warns, but the idea is that at a higher level you capture all those conditions and write them somewhere else. In case there is no handler, SBCL will print it on the REPL so that's fine too:
(defun note% (origin data)
(warn 'note
:timestamp (local-time:now)
:origin origin
:data data))
Finally, you can test that as follows:
(defun test (in)
(flet ((y (x) (note :x x)))
(note :before :in in)
(y 6)
(note :after)))
For example:
(test 15)
WARNING: 2022-10-19T15:17:05.297198Z (TEST 15) (:BEFORE :IN 15)
WARNING: 2022-10-19T15:17:05.297603Z ((FLET Y IN TEST) 6) (:X 6)
WARNING: 2022-10-19T15:17:05.297706Z (TEST 15) (:AFTER)
The easy way
Instead of doing all the above, you may want to activate tracing when giving your code to your users. You select the functions you want to trace, and redirect *TRACE-OUTPUT* to your logs (or use a custom report function, see below).
The SBCL implementation assumes that string arguments denote packages, but that's not portable. However this unportability has less impact as it is only done in one place and does not touch all the code. It is always possible to list all symbols and trace them explicitly if you want, or use reader macros to call the implementation-specific TRACE in a way that suits you.
For example, using SBCL, let's trace all the symbols in my newly created package:
(trace "LOGGING")
And run the same test:
(test 15)
0: (LOGGING::TEST 15)
1: (LOGGING::NOTE% (LOGGING::TEST 15) (:BEFORE :IN 15))
2: (LOGGING::NOTE-TIMESTAMP #<LOGGING::NOTE {100EC7CC33}>)
2: NOTE-TIMESTAMP returned #2022-10-19T15:22:05.315488Z
2: (LOGGING::NOTE-ORIGIN #<LOGGING::NOTE {100EC7CC33}>)
2: NOTE-ORIGIN returned (TEST 15)
2: (LOGGING::NOTE-DATA #<LOGGING::NOTE {100EC7CC33}>)
2: NOTE-DATA returned (:BEFORE :IN 15)
WARNING: 2022-10-19T15:22:05.315488Z (TEST 15) (:BEFORE :IN 15)
1: NOTE% returned NIL
1: (LOGGING::NOTE% ((FLET LOGGING::Y :IN LOGGING::TEST) 6) (:X 6))
2: (LOGGING::NOTE-TIMESTAMP #<LOGGING::NOTE {100EC9DBB3}>)
2: NOTE-TIMESTAMP returned #2022-10-19T15:22:05.319801Z
2: (LOGGING::NOTE-ORIGIN #<LOGGING::NOTE {100EC9DBB3}>)
2: NOTE-ORIGIN returned ((FLET Y :IN TEST) 6)
2: (LOGGING::NOTE-DATA #<LOGGING::NOTE {100EC9DBB3}>)
2: NOTE-DATA returned (:X 6)
WARNING: 2022-10-19T15:22:05.319801Z ((FLET Y IN TEST) 6) (:X 6)
1: NOTE% returned NIL
1: (LOGGING::NOTE% (LOGGING::TEST 15) (:AFTER))
2: (LOGGING::NOTE-TIMESTAMP #<LOGGING::NOTE {100ECAE773}>)
2: NOTE-TIMESTAMP returned #2022-10-19T15:22:05.323732Z
2: (LOGGING::NOTE-ORIGIN #<LOGGING::NOTE {100ECAE773}>)
2: NOTE-ORIGIN returned (TEST 15)
2: (LOGGING::NOTE-DATA #<LOGGING::NOTE {100ECAE773}>)
2: NOTE-DATA returned (:AFTER)
WARNING: 2022-10-19T15:22:05.323732Z (TEST 15) (:AFTER)
1: NOTE% returned NIL
0: TEST returned NIL
Without changing the code, I now can see exactly what is happening. In fact I do not need to implement logging functions at all.
Some implementations allows you to configure how tracing is being done, so if you want to add timestamps you should be able to do so too.
In SBCL, this is the :report option which accepts a function name.
Here I'm intercepting each entry using a custom my-report function:
(trace "LOGGING" :report my-report)
(defun my-report (&rest args)
(fresh-line *trace-output*)
(print (list* (local-time:now) args) *trace-output*))
For example:
(test 15)
(#2022-10-19T15:34:58.543114Z 0 LOGGING::TEST :ENTER #<SB-DI::COMPILED-FRAME SB-INT:SIMPLE-EVAL-IN-LEXENV> (15))
(#2022-10-19T15:34:58.552193Z 1 LOGGING::NOTE% :ENTER #<SB-DI::COMPILED-FRAME LOGGING::TEST> ((LOGGING::TEST 15) (:BEFORE :IN 15)))
(#2022-10-19T15:34:58.552359Z 2 LOGGING::NOTE-TIMESTAMP :ENTER #<SB-DI::COMPILED-FRAME (SB-KERNEL::CONDITION-REPORT LOGGING::NOTE)> (#<LOGGING::NOTE {100F5E7F23}>))
(#2022-10-19T15:34:58.552461Z 2 NOTE-TIMESTAMP :EXIT
#<SB-DI::COMPILED-FRAME (SB-KERNEL::CONDITION-REPORT NOTE)>
(#2022-10-19T15:34:58.552306Z))
....
There is no portable way.
There might be an implementation-specific way: examining the stack using the debugger &c, but it cannot possibly be reliable in any way because an optimizing compiler might eliminate or inline function calls.
This is a very common question among novice lispers, and the usual answer is that if your message is for the users, then they don't care about the function name, and if this is for developers, then they would benefit more from error than from a logging message (and error throws you into the debugger where you can examine the stack).
I know the answer is frustrating (because I was frustrated when I was told that 25 years ago) but I have since learned that it is the correct answer.
You are speaking about log messages: log4cl includes the function name by default in its log message (which is configurable).
(defun my-function ()
(log:info "hello"))
;; =>
<INFO> [20:59:42] my.package slimeQhYqRr (my-function) - hello
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 want to create an interpreted function definition, not a compiled one.
SBCL manual says :
Variable: *evaluator-mode* [sb-ext] : Toggle between different evaluator
implementations. If set to :compile, an implementation of eval that
calls the compiler will be used. If set to :interpret, an interpreter
will be used.
So, I try to create a BAR function (which does not exist) :
(let ((sb-ext::*evaluator-mode* :interpret))
(defun bar (x) (+ x 1)))
But then, I check, and BAR is already compiled :
CL-USER> (compiled-function-p #'bar)
T
So, how do you create an interpreted version of BAR ?
The let form in your question only sets the evaluator mode at runtime. By then, the function has already been compiled.
You need to set it at load time and also make sure to load the file instead of compiling then loading it.
Try this:
In your-file.lisp:
;; at load time, set evaluator mode to interpret (before bar definition is met)
(eval-when (:load-toplevel :execute)
(setf sb-ext::*evaluator-mode* :interpret))
;;define your interpreted function
(defun bar (x)
(+ x 1))
;; set evaluator back to compile mode (optional)
(eval-when (:load-toplevel :execute)
(setf sb-ext::*evaluator-mode* :compile))
;;check if bar is a compiled function
(print (compiled-function-p #'bar)) ;;prints NIL
Then load it with (load "your-file.lisp") (this doesn't compile the file first).
I think that *evaluator-mode* is pretty inherently a global variable. For instance, if you do this:
> (setf sb-ext:*evaluator-mode* ':interpret)
:interpret
> (setf (symbol-function 'bar)
(lambda (x) x))
#<interpreted-function nil {10026E7E2B}>
> (compiled-function-p #'bar)
nil
you get an interpreted function. But if you do this:
> (setf sb-ext:*evaluator-mode* ':compile)
:compile
> (setf (symbol-function 'bar)
(let ((sb-ext:*evaluator-mode* ':interpret))
(lambda (x) x)))
#<function (lambda (x)) {52C3687B}>
> (compiled-function-p #'bar)
t
You don't. My take on this, which may be wrong, is that the value which is in effect at the start of each top-level form is what counts: once the system has decided that it's going to use the compiling-evaluator for a form then it can't change its mind.
And note that there is a complicated definition of 'top-level form', and in particular that when processing a file then in a form like
(let (...)
(x ...))
then (x ...) is not a top-level form.
I have never been able to come up with a method to penetrate the set-process-sentinel hierarchy with let-bound variables defined at the outset of the function -- only buffer-local or global variables can penetrate it. Let-bound variables can reach the first start-process, but that is as far as they can penetrate without being rejected due to being unrecognized -- let-bound variables defined at the outset of the function do not appear to be able to penetrate the section that begins with (lambda (p e) . . .. Can anyone think of a way to do it, including penetrating nested sentinels like in the example below?
(set-process-sentinel
(start-process
"my-process-name-one"
"*OUTPUT-BUFFER*"
"/path/to/executable"
"argument-one"
"argument-two"
"argument-three")
(lambda (p e) (when (= 0 (process-exit-status p))
(set-process-sentinel
(start-process
"my-process-name-two"
nil ;; example of not using an output buffer
"/path/to/executable"
"argument-one"
"argument-two"
"argument-three")
(lambda (p e) (when (= 0 (process-exit-status p))
(set-process-sentinel
(start-process . . . ))))))))
The problem is that Emacs Lisp variable bindings are dynamic by default. That is, when a function is evaluated, bound variables are looked up not in the environment where the function was defined, but in the environment where the function was called.
Emacs 24 or later supports lexical binding (that is, the function sees the variables that were bound around the function definition) natively, but since it alters the semantics of existing code you need to enable it explicitly. Usually this is done by adding a file local variable setting to the first line of the .el file:
;; -*- lexical-binding: t; -*-
Another alternative is to use lexical-let from the cl library. This works in earlier Emacs versions as well. Note that in this way you explicitly specify which variables should have lexical binding, so code such as (lexical-let ((foo foo)) ...) is not uncommon — foo is an existing variable which needs to be "carried over" into the function.
The following is an example using dynamic bindings:
(defun example-dynamic-fn ()
"Doc-string"
(interactive)
(let ((test-variable "Hello-world!"))
(set-process-sentinel
(start-process "process-one" "*one*" "echo" test-variable)
`(lambda (p e) (when (= 0 (process-exit-status p))
(set-process-sentinel
(start-process "process-two" "*two*" "echo" ,test-variable)
'(lambda (p e) (when (= 0 (process-exit-status p))
(start-process "process-three" "*three*" "echo" ,test-variable)
(set-process-sentinel
(start-process "process-four" "*four*" "echo" ,test-variable)
'(lambda (p e) (when (= 0 (process-exit-status p))
(set-process-sentinel
(start-process "process-five" "*five*" "echo" ,test-variable)
'(lambda (p e) (when (= 0 (process-exit-status p))
(message "test-variable: %s" ,test-variable)))))))))))))))
OK, I think I've got this now. The link above provides a good example; here's another in case anyone else has this difficulty:
;;; ensure VAR1 has no binding
(makunbound 'VAR1)
;;;
(defun f1 (&optional VAR1)
(interactive)
(unless VAR1
(set 'VAR1 "variable1"))
(pop-to-buffer "*test*")
; (lexical-let ( (VAR1 VAR1) ) ;;;
(set-process-sentinel
(start-process-shell-command "test"
"*test*"
(concat "echo " VAR1))
(lambda (process event)
(condition-case err
(when (string-match-p "finished" event)
(f2 VAR1))
(error
(princ
(format "Sentinel error: %s" err))))))
; ) ;;;
)
;;;
(defun f2 (&optional VAR2)
(interactive)
(unless VAR2
(set 'VAR2 "VARIABLE2"))
(print VAR2))
We load everything (with the lines in (f1) commented out) and run (f1). The value of VAR1 is passed to (f2) before the error occurs. The error (void-variable VAR1) appears to come from the scoping environment of (set-process sentinel PROCESS SENTINEL); VAR1 is not defined there even though it remains in scope for the SENTINEL ((lambda)) function.
Also using (set ) as above is not best practice when a variable is only meant to have scope local to the function.
If we uncomment the lines marked with ; then everything works as expected. Happily, we can pass the value through to another function, which prevents a long series of (set-process sentinel )s building up. It also allows us to generate processes with additional sub-processes, if required.
One of my mistakes was naming the SENTINEL as a discrete function, rather than keeping it inside the (lexical-let ) function. While the lexical-binding: t; approach is attractive, it will tend to break working code which relies on the standard (let ).
Given
(defun show-arg (a)
(format t "a is ~a~%" a))
(defun show-key (&key a)
(format t "a is ~a~%" a))
evaluating
(show-arg)
will lead to an error saying "invalid number of arguments: 0", where
(show-key)
will display a is NIL
How can I get SHOW-KEY to signal an error like SHOW-ARG does? Is there a way other than using (unless a (error "a is required")) in the function body? I am very fond of keyword arguments and use them constantly, and almost always want them to be required.
Keyword arguments are always optional, so you do need to manually check if they're given and signal an error if needed. It would be better to not require keyword arguments though. The compiler won't recognize them as required and thus won't given you an error message for missing arguments at compile time.
If you do want to require them, you can specify the arguments with a three element list; the first element being the argument, the second is the default value and the third is a variable that will be true if the argument was given. Checking the third element is better than checking the keyword itself, because then you can tell the difference between a NIL that was the default, and a NIL that the user gave as an argument.
(defun foo (&key (keyarg nil keyargp))
(unless keyargp (error "KEYARG is required."))
(* keyarg 2))
Edit
Now that I think about this a bit more, there actually is a way to get compile time errors for missing keyword arguments. Define a compiler macro for the function:
(defun foo (&key a b c d)
(* a b c d))
(define-compiler-macro foo (&whole whole &key (a nil ap) (b nil bp)
(c nil cp) (d nil dp))
(declare (ignore a b c d))
(unless (and ap bp cp dp)
(error "Missing arguments..."))
whole)
One possibility would be:
(defun foo (&key (arg1 (error "missing arg1 in call to function foo")))
arg1)
Using it:
CL-USER 80 > (foo)
Error: missing arg1 in call to function foo
1 (abort) Return to level 0.
2 Return to top loop level 0.
This will give an error at runtime, unfortunately not at compile time.
I am curious how
(write
(make-instance 'simple-error
:format-control "A:~a ~% B:~a~%"
:format-arguments `("A" "B"))
:stream nil)
works, as I tried to implement it myself to gain experience in basic lisp funcionality but soon had to realize, that I am not able to. As the intuitive way of implementation:
(defmethod my-write ((simple-error err))
(FORMAT nil (if (simple-condition-format-control err)
(simple-condition-format-control err)
"")
(simple-condition-format-arguments err)))
obviously cannot work, as (simple-condition-format-arguments err) returns the list of arguments and therefore, in the example above, "B:~a" does not have a corresponding parameter to print.
So how would I actually implement this method?
You can use apply for this. It takes the function passed as its first argument and applies it to arguments constructed from its other arguments. For example, (apply #'f 1 2) calls (f 1 2), (apply #'f 1 '(2 3)) calls (f 1 2 3) and so on. It's perfectly suited for this situation.
SBCL has a function almost identical to yours:
(defun simple-condition-printer (condition stream)
(let ((control (simple-condition-format-control condition)))
(if control
(apply #'format stream
control
(simple-condition-format-arguments condition))
(error "No format-control for ~S" condition))))
As mentioned by Samuel, you need to use APPLY.
Also note that NIL for the stream in WRITE does something else than in FORMAT. With FORMAT the stream argument NIL causes the output to be returned as a string. With man other output functions, like WRITE, it means standard output.