Why don't reader macro extensions propagate to runtime (read)? - lisp

Why does the following not work?
;;;; foo.lisp
(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-interpol))
(cl-interpol:enable-interpol-syntax)
(defun read-and-eval (s)
(eval (read-from-string s)))
(cl-interpol:disable-interpol-syntax)
then:
LISP> (load (compile-file "foo.lisp"))
=> T
LISP> (read-and-eval
"(let ((a \"foo\")) (princ #?\"${a}\"))")
=> no dispatch function defined for #\?

Because there's only a single reader, with global state. You're effectively turning your macros on and off. In this case the reader macros are enabled only for the duration that your read-and-eval function is read at compile time.
In this case you would need to set the macros up within the read-and-eval function to ensure the reader is in the proper state when you need it.

CL:READ dispatches based on the readtable bound to CL:*READTABLE* at the time the call to READ runs. Under the hood ENABLE-INTERPOL-SYNTAX is creating a new readtable, setting CL:*READTABLE* to hold it, and stashing the old value of CL:*READTABLE*. DISABLE-INTERPOL-SYNTAX is unstashing the previous readtable and setting CL:*READTABLE* to again hold it. Minimally changing your original setup, you can arrange for the behavior you wanted by the following:
(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-interpol))
(cl-interpol:enable-interpol-syntax)
(defvar *interpol-reader* *readtable*)
(cl-interpol:disable-interpol-syntax)
(defun read-and-eval (s)
(let ((*readtable* *interpol-reader*))
(eval (read-from-string s))))
The call to disable the syntax could be placed anywhere after the defvar and read-and-eval will still work, but if you want to directly input interpol syntax in the file that syntax will have to be placed between the enable and disable calls. For that latter purpose it is significant that the interpol calls expand into EVAL-WHENs, for the same reason that it is necessary for your call to REQUIRE to be within an EVAL-WHEN; that is, the effects need to have already happened when the latter forms are READ.
CL-INTERPOL's interface abstracts what is happening, so I will show you how you might manually create and change a readtable:
;; Create a fresh readtable with standard syntax
(defvar *not-readtable* (copy-readtable nil))
;; A simple reader function
(defun not-reader (stream char &optional count)
"Like ' but for (not ...) instead of (quote ...)"
(declare (ignore count char))
`(not ,(read stream t nil t)))
;; Mutate that readtable so that the dispatch character you want
;; calls the function you want
(set-macro-character #\! 'not-reader nil *not-readtable*)
;; Try it out
(let ((*readtable* *not-readtable*))
(read-from-string "(if !foo bar baz)"))
=>
(IF (NOT FOO)
BAR
BAZ)

Related

Is there any way to see the implementations of built-in macros in Common Lisp?

Common Lisp built-in functions are probably implemented in C. But I imagine macros are implemented in lisp (sorry if I'm wrong about any of two sentences). Is there any way (through some function or some macro) to see the implementations of built-in macros in Common Lisp? I'm using CLisp.
The ability to inspect function and macro definitions is a feature of your development environment. These days it is typical to use SLIME or SLY with emacs as the basis of a Lisp development environment. I personally use SLIME, but I have heard good things about SLY, too.
In SLIME you can invoke slime-edit-definition (either by keying M-x slime-edit-definition or by using the keybinding M-.) to visit a definition for the symbol under the cursor in a source file. This works both when editing in a source file, or from the REPL. This feature is extremely useful when you want to inspect some library code you are working with, but you can also view a lot of built-in definitions this way. You can even jump to a new definition from a new symbol found in whatever definition you are currently inspecting.
After you are done looking at a definition, you can use M-x slime-pop-find-definition-stack, or the easier to remember keybinding M-, (M-* will also work), to back out through the previously viewed definitions, eventually returning to your starting point.
Here is an example, in SBCL:
CL-USER> with-open-file[press M-.]
(Note that the "[press M-.]" above is not typed, but only meant to remind what action is taken here). With the cursor on or right after the symbol with-open-file, press M-. to see the definition:
(sb-xc:defmacro with-open-file ((stream filespec &rest options)
&body body)
(multiple-value-bind (forms decls) (parse-body body nil)
(let ((abortp (gensym)))
`(let ((,stream (open ,filespec ,#options))
(,abortp t))
,#decls
(unwind-protect
(multiple-value-prog1
(progn ,#forms)
(setq ,abortp nil))
(when ,stream
(close ,stream :abort ,abortp)))))))
This time after keying M-. SLIME gives a choice of definitions to view:
CL-USER> and[press M-.]
Displayed in an emacs buffer:
/path-to-source/sbcl-2.0.4/src/code/macros.lisp
(DEFMACRO AND)
/path-to-source/sbcl-2.0.4/src/pcl/ctypes.lisp
(DEFINE-METHOD-COMBINATION AND)
We want to see the macro definition, so move the cursor to the line showing (DEFMACRO AND), and the following definition is displayed:
;; AND and OR are defined in terms of IF.
(sb-xc:defmacro and (&rest forms)
(named-let expand-forms ((nested nil) (forms forms) (ignore-last nil))
(cond ((endp forms) t)
((endp (rest forms))
(let ((car (car forms)))
(cond (nested
car)
(t
;; Preserve non-toplevelness of the form!
`(the t ,car)))))
((and ignore-last
(endp (cddr forms)))
(car forms))
;; Better code that way, since the result will only have two
;; values, NIL or the last form, and the precedeing tests
;; will only be used for jumps
((and (not nested) (cddr forms))
`(if ,(expand-forms t forms t)
,#(last forms)))
(t
`(if ,(first forms)
,(expand-forms t (rest forms) ignore-last))))))
There is more stuff here, since you are now actually in the source file that contains the definition for and; if you scroll down a bit you can also find the definition for or.
A lot of SBCL functions are written in Lisp; SBCL has a very high-quality compiler, so a lot of stuff that you might otherwise expect to be written in C can be written in Lisp without loss of performance. Here is the definition for the function list-length:
CL-USER> list-length[press M-.]
(defun list-length (list)
"Return the length of the given List, or Nil if the List is circular."
(do ((n 0 (+ n 2))
(y list (cddr y))
(z list (cdr z)))
(())
(declare (type fixnum n)
(type list y z))
(when (endp y) (return n))
(when (endp (cdr y)) (return (+ n 1)))
(when (and (eq y z) (> n 0)) (return nil))))
The same thing can be done when using CLISP with SLIME. Here is with-open-file as defined in CLISP:
CL-USER> with-open-file[press M-.]
(defmacro with-open-file ((stream &rest options) &body body)
(multiple-value-bind (body-rest declarations) (SYSTEM::PARSE-BODY body)
`(LET ((,stream (OPEN ,#options)))
(DECLARE (READ-ONLY ,stream) ,#declarations)
(UNWIND-PROTECT
(MULTIPLE-VALUE-PROG1
(PROGN ,#body-rest)
;; Why do we do a first CLOSE invocation inside the protected form?
;; For reliability: Because the stream may be a buffered file stream,
;; therefore (CLOSE ,stream) may produce a disk-full error while
;; writing the last block of the file. In this case, we need to erase
;; the file again, through a (CLOSE ,stream :ABORT T) invocation.
(WHEN ,stream (CLOSE ,stream)))
(WHEN ,stream (CLOSE ,stream :ABORT T))))))
But, many CLISP functions are written in C, and those definitions are not available to inspect in the same way as before:
CL-USER> list-length[press M-.]
No known definition for: list-length (in COMMON-LISP-USER)

How is the defun macro implemented in lisp?

I'd like to learn more about lisp macros and I want to create a simple implementation of the defun macro.
I'm also interested in lisp's source code in all the implementations.
This is a tricky question, because of bootstrapping: defun does a lot of things (iow, calls a lot of functions), but to define those functions one needs a working defun. Thus there are three(3!) definitions of defun in clisp/src/init.lisp: at lines
228
1789
1946
The very basic definition of defun could be this:
(defmacro defun (fname lambda-list &rest body)
`(setf (fdefinition ',fname)
(lambda ,lambda-list
(block ,fname ,#body))))
In fact, this is the first definition of defun in CLISP (line 228), except that there is no defmacro and no backquote at that moment yet, so the actual code looks a lot uglier.
See also Is defun or setf preferred for creating function definitions in common lisp and why? where I discuss macroexpansions of defuns.
You can easily check how your particular CL implementation, implemented defun by running
(macroexpand '(defun add2 (x) (+ x 2)))
On SBCL it expands to:
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL) (SB-C:%COMPILER-DEFUN 'ADD2 NIL T))
(SB-IMPL::%DEFUN 'ADD2
(SB-INT:NAMED-LAMBDA ADD2
(X)
(BLOCK ADD2 (+ X 2)))
(SB-C:SOURCE-LOCATION)))
T
To see the particular source code that implemented the I would use (on Emacs) the M-. key binding and then I will write defun and hit enter. Then Emacs will get to the source code:
(sb!xc:defmacro defun (&environment env name lambda-list &body body)
#!+sb-doc
"Define a function at top level."
[...]
I am not going to paste the whole macro as it is rather long. If you are not on Emacs, you can try searching in the repos as most implementations are open source.
BTW defun is not so special. You can implement much of it with setf-inf a symbol-function to a lambda. E.g.:
(setf (symbol-function 'ADD3) #'(lambda (x) (+ x 3)))
; => #<FUNCTION (LAMBDA (X)) {1006E94EBB}>
(add3 4)
; => 7

Can I put condition in emacs lisp macro?

How to achieve something like this?
(defmacro mood (x)
(if (equal (symbol-name x) "t")
`(defun happy ()
(message "Happy"))
`(defun sad ()
(message "Sad")))
)
My aim is to create different function base on argument.
Is there any problem doing so?
Edit 2: You're right -- for cases in which the code being evaluated at expansion-time is entirely dependent on the values of the (unevaluated) macro arguments, I believe it is safe for the macro's returned form to be generated conditionally, based upon those arguments.
You just need to be aware that any behaviour which is conditional upon dynamic values needs to be dealt with as a part of the expanded form.
(e.g. if the macro argument were a variable, and you were testing the value of the variable in your condition, it would be unsafe for that test to occur at expansion time, as that value is liable to vary between the macro's expansion time, and the time(s) that the expanded code is evaluated.)
So the specific example in your question is indeed safe as-is, and therefore my variations (below) are not actually necessary in this case. However expansion-time evaluations are certainly something you will want to be cautious about in general.
Initial answer follows...
Macros are expanded at compile time. (Or in recent versions of Emacs, should no byte-compiled version of the library be available, they will usually be compiled "eagerly" at load time).
In these scenarios, any code which is not a part of the form returned by the macro will be evaluated at most once per session, but quite likely just once ever for a given expansion of the code (whereas the expanded code might then be called numerous times).
If you need your expanded code to act conditionally at run-time, the conditions must be a part of the form returned by the macro.
Edit: For example, I imagine you actually wanted to write something more like:
(defmacro mood (x)
`(if (equal (symbol-name ,x) "t")
(defun happy ()
(message "Happy"))
(defun sad ()
(message "Sad"))))
Although you would (almost) never want to compare symbols by comparing their symbol-name. You've already made the assumption that the macro argument will evaluate to a symbol, so just compare the symbols directly with eq:
(defmacro mood (x)
`(if (eq ,x t)
(defun happy ()
(message "Happy"))
(defun sad ()
(message "Sad"))))
Then for example, (mood 'foo) expands to (courtesy of M-x pp-macroexpand-last-sexp):
(if
(eq 'foo t)
(defun happy nil
(message "Happy"))
(defun sad nil
(message "Sad")))
There is no problem defining it. You code, actually, almost works:
(defmacro mood (x)
(if (equal x t)
`(defun happy ()
(message "Happy"))
`(defun sad ()
(message "Sad"))))
Since if is outside of back-quotes, we can examine the value of x directly. Expanding this definition with different arguments shows that different functions are defined:
> (macroexpand '(mood t))
(defalias (quote happy) (function (lambda nil (message "Happy"))))
> (macroexpand '(mood nil))
(defalias (quote sad) (function (lambda nil (message "Sad"))))

Manually exit a temporary overlay map

In emacs 24, set-temporary-overlay-map makes active a keymap which becomes inactivated as soon as the user presses a key which is not defined in that keymap.
I need to inactivate the overlay keymap manually, but no function is provided to do this in particular. I've peeked into the source code:
(defun set-temporary-overlay-map (map &optional keep-pred)
"Set MAP as a temporary keymap taking precedence over most other keymaps.
Note that this does NOT take precedence over the \"overriding\" maps
`overriding-terminal-local-map' and `overriding-local-map' (or the
`keymap' text property). Unlike those maps, if no match for a key is
found in MAP, the normal key lookup sequence then continues.
Normally, MAP is used only once. If the optional argument
KEEP-PRED is t, MAP stays active if a key from MAP is used.
KEEP-PRED can also be a function of no arguments: if it returns
non-nil then MAP stays active."
(let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
(overlaysym (make-symbol "t"))
(alist (list (cons overlaysym map)))
(clearfun
;; FIXME: Use lexical-binding.
`(lambda ()
(unless ,(cond ((null keep-pred) nil)
((eq t keep-pred)
`(eq this-command
(lookup-key ',map
(this-command-keys-vector))))
(t `(funcall ',keep-pred)))
(set ',overlaysym nil) ;Just in case.
(remove-hook 'pre-command-hook ',clearfunsym)
(setq emulation-mode-map-alists
(delq ',alist emulation-mode-map-alists))))))
(set overlaysym overlaysym)
(fset clearfunsym clearfun)
(add-hook 'pre-command-hook clearfunsym)
;; FIXME: That's the keymaps with highest precedence, except for
;; the `keymap' text-property ;-(
(push alist emulation-mode-map-alists)))
I gather that the mechanism to inactivate the current overlay keymap is as follows:
A function clearfun is defined to run before every command, checking if the previous command invoked was in the map.
If it was not in the map, the following code is executed:
(Why doesn't this format correctly? Ok, now it does)
(set ',overlaysym nil) ;Just in case.
(remove-hook 'pre-command-hook ',clearfunsym)
(setq emulation-mode-map-alists
(delq ',alist emulation-mode-map-alists))
Thus, what I really want is to execute the code above with the appropriate variables. But this code is part of a closure, and I'm having trouble determining values like overlaysym, clearfunsym, alist inside the closure. I tried looking for clearfunsym by eval-ing pre-command-hook, but strangely nothing is there (except for another unrelated hook).
I tried re-evaluating the function defintion and edebugging it, and I notcied after the (add-hook 'pre-command-hook clearfunsym), pre-command-hook is still nil, which puzzles me. I will continue digging deeper into the source code, and maybe I will just rewrite my own version of this function to additionally produce a force-clear function that I can call later, but maybe someone can see a cleaner solution.
You wrote: "I'm having trouble determining values like overlaysym"
But, overlaysym is evaluated. It has the value (make-symbol "t").
It is a symbol with name t. This makes it hard to access it but not impossible.
Evaluation of the following lines gives the out-commented results:
(setq mysym (make-symbol "t"))
;; t
(set mysym 'test)
;; test
(symbol-value mysym)
;; test
The same applies to clearfunsym which evaluates to clear-temporary-overlay-map.
One more comment: When you debug set-temporary-overlay-map you are hitting keys. Might it be that these keystrokes call clear-temporary-overlay-map and clear pre-command-hook?
Try that:
(defadvice set-temporary-overlay-map (after test activate)
(setq test-pre-command-hook pre-command-hook))
Then enter text-scale-mode (C-+) and look at test-pre-command-hook. For an istance evaluating test-pre-command-hook on my computer gave me the following list:
(clear-temporary-overlay-map tooltip-hide).
Let us do the same with emulation-mode-map-alists. Then we get:
(((t keymap (67108912 . #[0 "\301\302\300!!\207" [1 text-scale-adjust abs] 3 "
...
(fn)" nil]) (45 . #[0 "\301\302\300!!\207" [1 text-scale-adjust abs] 3 "
(fn)" nil]))))
Especially, note the t at the beginning. That means you find the overlay map by searching for the list with symbol t at the beginning.
Something like the following code fragment should be sufficient to delete the overlay map:
(when (assoc-string "t" (car emulation-mode-map-alists))
(setq emulation-mode-map-alists (cdr emulation-mode-map-alists)))
The when is just a protection. (Maybe, something else has killed the map before?) The temporary map should always be at the front (because of the push in set-temporary-overlay-map). Does anything have a chance to put another keymap in front of it? Maybe, something time-controlled? Then you would need to search emulation-mode-map-alists for the alist with the (make-symbol "t") keymap.
The original set-temporary-overlay-map is very confusing, unreadable, and relies on a lot of unnecessary dirty hacks and tricks. Using lexical binding, I have rewritten the function in a way that is more clear and modular.
The revised function uses lexical-binding to replace the eager-lazy evaluation hacks (in this case they are completely unnecessary).
The original function unnecessarily creates two symbols for each function, (clearfunsym and clear-fun are basically the same thing, the later being used only as the function cell of the former)
The revised function provides an force-overlay-clear, which is called by the clear-temporary-overlay-map pre-command-hook when the conditions are met (ie, that the last key was not in the overlay map). It can also be called by the user if he wants to manually clear this map. The function voids force-overlay-clear's own function cell, so it will err if called twice.
Code to test whether clear is applicable simplified.
I was not able to do away with the extremely weird (overlaysym (make-symbol "t")), fearing that some other code might rely on this t symbol. Thus, the revised version is almost certainly equivalent to the original version. I have tested this, and it works nicely.
(defun set-temporary-overlay-map (map &optional keep-pred)
(lexical-let* (
(map map)
(keep-pred keep-pred)
(clear-temporary-overlay-map nil)
(force-overlay-clear nil)
(overlaysym (make-symbol "t"))
(alist (list (cons overlaysym map))))
(fset 'force-overlay-clear (lambda ()
(message "clearing overlay")
;this is a copy of the original code to clear
(set overlaysym nil) ;Just in case.
(remove-hook 'pre-command-hook 'clear-temporary-overlay-map)
(setq emulation-mode-map-alists
(delq alist emulation-mode-map-alists))
;void the function cell of 'force-overlay-clear', an attempt to clear overlay twice will err
(fset 'force-overlay-clear nil)
))
(fset 'clear-temporary-overlay-map (lambda ()
(unless (cond
((null keep-pred) nil)
(keep-pred
(lookup-key map (this-command-keys-vector)))
(t (funcall keep-pred)))
(force-overlay-clear)
)))
(set overlaysym overlaysym)
(add-hook 'pre-command-hook 'clear-temporary-overlay-map)
;; FIXME: That's the keymaps with highest precedence, except for
;; the `keymap' text-property ;-
(push alist emulation-mode-map-alists))
)
You can do the following:
(defun my-exit-command ()
(do-what-the-q-key-should-do))
....(set-temporary-overlay-map
my-overlay-map
(lambda ()
(and (eq this-command (lookup-key my-overlay-map
(this-single-command-keys)))
(not (eq this-command 'my-exit-command)))))
....

How to extend emacs lisp mode with indentation changes and color changes

Im making a DSL in lisp (basically what i think is a nicer syntax), its the same thing as lisp except with different 'primitives', no instead of not, 'as' instead of let.Thus i need to change both indentation and color only in files which end in .goby (it should not effect ones which end in .lisp) So i would like to create files with extension of .goby, and have my new, minor/major mode enabled (but with everything else besides syntax inherited from lisp).
However, whatever i do it also effects .lisp files! Anyone?
For example, I tried to make a local variable for unique lisp indentation which would indent
'hi' by 10 spaces. but it effected all .lisp files also
;;in goby.el
(define-derived-mode
goby-mode lisp-mode "Goby"
"Major mode"
(let ((func #'lisp-indent-function))
(set (make-local-variable 'lisp-indent-function) func)
(put 'hi 'lisp-indent-function 10)))
(provide 'goby)
;;in .emacs
(setq auto-mode-alist
(append auto-mode-alist
'(("\\.gy\\'" . goby-mode))))
There's probably a cleaner way, but a way that works is to rewrite 'lisp-indent-function to be 'goby-indent-function and use your own table of offsets like so:
(define-derived-mode
goby-mode lisp-mode "Goby"
"Major mode"
(set (make-local-variable 'lisp-indent-function) 'goby-indent-function))
;; goby specific offsets here
(put 'hi 'goby-indent-function 10)
(put 'if 'goby-indent-function 4)
(defun goby-indent-function (indent-point state)
"Same as 'lisp-indent-function but uses 'goby-indent-function symbol
This function is the normal value of the variable `goby-indent-function'.
It is used when indenting a line within a function call, to see if the
called function says anything special about how to indent the line.
INDENT-POINT is the position where the user typed TAB, or equivalent.
Point is located at the point to indent under (for default indentation);
STATE is the `parse-partial-sexp' state for that position.
If the current line is in a call to a Lisp function
which has a non-nil property `goby-indent-function',
that specifies how to do the indentation. The property value can be
* `defun', meaning indent `defun'-style;
* an integer N, meaning indent the first N arguments specially
like ordinary function arguments and then indent any further
arguments like a body;
* a function to call just as this function was called.
If that function returns nil, that means it doesn't specify
the indentation.
This function also returns nil meaning don't specify the indentation."
(let ((normal-indent (current-column)))
(goto-char (1+ (elt state 1)))
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(if (and (elt state 2)
(not (looking-at "\\sw\\|\\s_")))
;; car of form doesn't seem to be a symbol
(progn
(if (not (> (save-excursion (forward-line 1) (point))
calculate-lisp-indent-last-sexp))
(progn (goto-char calculate-lisp-indent-last-sexp)
(beginning-of-line)
(parse-partial-sexp (point)
calculate-lisp-indent-last-sexp 0 t)))
;; Indent under the list or under the first sexp on the same
;; line as calculate-lisp-indent-last-sexp. Note that first
;; thing on that line has to be complete sexp since we are
;; inside the innermost containing sexp.
(backward-prefix-chars)
(current-column))
(let ((function (buffer-substring (point)
(progn (forward-sexp 1) (point))))
method)
(setq method (or (get (intern-soft function) 'goby-indent-function)
(get (intern-soft function) 'lisp-indent-hook)))
(cond ((or (eq method 'defun)
(and (null method)
(> (length function) 3)
(string-match "\\`def" function)))
(lisp-indent-defform state indent-point))
((integerp method)
(lisp-indent-specform method state
indent-point normal-indent))
(method
(funcall method indent-point state)))))))