Lisp method process - lisp

Can you help me? I don't understand this code's part
(lambda (this &rest args) ;; Adds The THIS Argument
(apply (get-slot this
method-name)
(append (list this)
args))))
Rewrite Method
;;;; This Function Add The Argument This To The Method
(defun rewrite-method (method-spec)
(list 'lambda (append (list 'this) ;; Add The THIS Argument
(second method-spec))
(cons 'progn (rest (rest method-spec))))) ;; Eval All The Method's Body
;;;; Method-Process
;;;; Function Used To Process Methods, Rewriting Them To
;;;; Lisp Functions
(defun method-process (method-name method-spec)
(setf (fdefinition method-name) ;; Associate The Lambda To The Method's Name
(lambda (this &rest args) ;; Adds The THIS Argument
(apply (get-slot this
method-name)
(append (list this)
args))))
(eval (rewrite-method method-spec))) ;; Returned Value

It takes an arglist (foo bar baz) and adds a this parameter: (this foo bar baz).
Thus a function (lambda (foo bar baz) ...) then is (lambda (this foo bar baz) ...).
This is useful in implementation of single-inheritance object-oriented languages where the first argument is the object which receives a message and other arguments. Here the parameter this is the receiving object.
Note that the call to APPLY could be improved. (apply function (append (list this) args)) is just (apply function this args).

Related

Extracting and executing a closure/lambda from a plist macro body

I'm trying to create a macro (bar) that should be used like this:
(let ((my-var "foo"))
(bar ("some")
:buzz (lambda () (format t "~a~%" my-var))))
The macro should basically just FUNCALL the lambda with taking MY-VAR into account.
What I've come up with is this:
(defmacro bar ((thing) &body body)
`(funcall (coerce (getf (list ,#body) :buzz) 'function)))
This works, it prints "foo".
But I'd like to know if this is how this is done or if there is a better way of doing this.
Well, for a start if you don't need the extra, unused argument, then this is just funcall, since (lambda ...) denotes a function.
(let ((my-var "foo"))
(funcall (lambda () (format t "~a~%" my-var))))
So even if you didn't want to call this funcall you could write it as a function, not a macro: it's not doing any code transformation. But presumably you actually do need this extra argument, and you are intending to use it for some purpose in the expansion, so what you need then is a macro which takes keyword arguments and just expands into a suitable funcall form:
(defmacro bar ((thing) &key (buzz '(lambda ())))
(declare (ignore thing))
`(funcall ,buzz))

Common Lisp macro let-curry - not working

I found myself calling lots of methods whose first argument is a complex object from a given class.
Whilst with-slots and with-accessors are useful, generic methods cannot be bound in this way. So I thought: if we could locally curry any functions, slots + accessors + generic functions + functions could all be addressed with the same construct.
Example of code I want to clean up:
(defun clox-string (scanner)
"Parse string into a token and add it to tokens"
(loop while (and (char/= #\" (peek scanner))
(not (at-end-p scanner)))
do
(if (char= #\Newline (peek scanner)) (incf (line scanner))
(advance scanner)))
(when (at-end-p scanner)
(clox.error::clox-error (line scanner) "Unterminated string.")
(return-from clox-string nil))
(advance scanner) ;; consume closing "
(add-token scanner 'STRING (subseq (source scanner)
(1+ (start scanner))
(1- (current scanner)))))
This would be cleaner (I'm imitating this in CL https://craftinginterpreters.com/scanning.html#reserved-words-and-identifiers but I often end up with more verbose and less readable code than in Java - specially when using this classes a lot). As in CL methods don't belong to classes you end up declaring such arguments over and over. This would be a bit better:
(defun clox-string (scanner)
"Parse string into a token and add it to tokens"
(let-curry scanner (peek at-end-p line source start current advance add-token)
(loop while (and (char/= #\" (peek))
(not (at-end-p)))
do
(if (char= #\Newline (peek)) (incf (line))
(advance)))
(when (at-end-p)
(clox.error::clox-error (line) "Unterminated string.")
(return-from clox-string nil))
(advance) ;; consume closing "
(add-token 'STRING (subseq (source)
(1+ (start))
(1- (current)))))
sketch of macro (not working):
;; Clearly not as I don't understand macros very well :) non-working code:
(defmacro let-curry (obj functions &body body)
"Locally curry all functions"
(let ((fn (gensym)))
`(flet (loop
for ,fn in ,functions
collect (list ,fn (&rest args)
(funcall ,fn ,obj args)))
,#body)))
EDIT (ADD): Notice that scanner is a class; start, source, line, etc., accessors to the slots with the same name; add-token a generic function of more than one argument, advance a generic method of one argument:
(defclass scanner ()
((source
:initarg :source
:accessor source)
...
(...)))
(defmethod advance ((scanner scanner)) ...)
(defmethod add-token ((scanner scanner) token-type) ...)
Simpler Example with error:
;; With
(defun add (x y) (+ x y))
(defun mul (x y) (* x y))
;; I want to have this:
(let-curry 1000 (add mul)
(print (add 3))
(print (mul 3)))
;; expanding to:
(flet ((add (y) (add 1000 y))
(mul (y) (mul 1000 y)))
(print (add 3))
(print (mul 3)))
;; but instead I'm getting:
Execution of a form compiled with errors.
Form:
(FLET (LOOP
FOR
#1=#:G777
IN
(ADD MUL
)
COLLECT
(LIST #1#
(&REST ARGS)
(FUNCALL #1# 1000 ARGS)))
(PRINT (ADD 3))
(PRINT (MUL 3)))
Compile-time error:
The FLET definition spec LOOP is malformed.
[Condition of type SB-INT:COMPILED-PROGRAM-ERROR]
Thanks! The basic question is: is it possible to make such macro work?
Your version didn't expand to what you wanted but:
(flet (loop for #:g8307 in (add mul) collect (list #:g8307 (&rest args) (funcall #:g8307 1000 args)))
(print (add 3)) (print (mul 3)))
Now the loop needs to be done at macro expansion time.
Here is a working version:
(defmacro let-curry (obj (&rest functions) &body body)
"Locally curry all functions"
`(flet ,(loop for fn in functions
collect `(,fn (&rest args)
(apply #',fn ,obj args)))
,#body))
;; test it using add and mul from OP
(macroexpand-1 '(let-curry 10 (add mul) (list (add 5) (mul 5))))
;; ==>
(flet ((add (&rest args) (apply #'add 10 args))
(mul (&rest args) (apply #'mul 10 args)))
(list (add 5) (mul 5)))
(let-curry 10 (add mul) (list (add 5) (mul 5)))
;; ==> (15 50)
Using gensym is only needed if you are in danger of shadowing/colliding something or to ensure evaluation order is least surprising, but in your case you actually want to shadow the original names with the curried version so it makes sense to just use the original name.
If you want to have more than one argument you should use apply
since you know the function is in the function namespace you need to call #'symbol instead of symbol.
I've done (&rest functions) instead of functions in the prototype that with bad usage (not a list) you get a compile time error and it is more preciese.

Is defun or setf preferred for creating function definitions in common lisp and why?

What is the fundamental difference in the functions defined using defun and setf as below and is one method preferred over another outside of style considerations?
Using defun:
* (defun myfirst (l)
(car l) )
MYFIRST
* (myfirst '(A B C))
A
Using setf:
* (setf (fdefinition 'myfirst) #'(lambda (l) (car l)))
#<FUNCTION (LAMBDA (L)) {10021B477B}>
* (myfirst '(A B C))
A
If, as according to Wikipedia:
named functions are created by storing a lambda expression in a symbol using the defun macro
Using setf to create a variable in a different way requires the use of funcall:
* (defvar myfirst)
MYFIRST
* (setf myfirst (lambda (l) (car l)))
#<Interpreted Function (LAMBDA (X) (+ X X)) {48035001}>
* (funcall myfirst '(A B C))
A
My understanding is that this type of variable is different than the previous in that this variable is not found in the same namespace as the defun bound symbol as described in Why multiple namespaces?.
First of all, one should never underestimate the importance of style.
We write code not just for computers to run, but, much more importantly, for people to read.
Making code readable and understandable for people is a very important aspect of software development.
Second, yes, there is a big difference between (setf fdefinition) and defun.
The "small" differences are that defun can also set the doc string of the function name (actually, depending on how your imeplementation works, it might do that with lambda also), and creates a named block (seen in the macroexpansions below) which you would otherwise have to create yourself if you want to.
The big difference is that the compiler "knows" about defun and will process it appropriately.
E.g., if your file is
(defun foo (x)
(+ (* x x) x 1))
(defun bar (x)
(+ (foo 1 2 x) x))
then the compiler will probably warn you that you call foo in bar with the wrong number of arguments:
WARNING: in BAR in lines 3..4 : FOO was called with 3 arguments, but it requires 1
argument.
[FOO was defined in lines 1..2 ]
If you replace the defun foo with (setf (fdefinition 'foo) (lambda ...)), the compiler is unlikely to handle it as carefully. Moreover, you will probably get a warning along the lines of
The following functions were used but not defined:
FOO
You might want to examine what defun does in your implementation by macroexpanding it:
(macroexpand-1 '(defun foo (x) "doc" (print x)))
CLISP expands it to
(LET NIL (SYSTEM::REMOVE-OLD-DEFINITIONS 'FOO)
(SYSTEM::EVAL-WHEN-COMPILE
(SYSTEM::C-DEFUN 'FOO (SYSTEM::LAMBDA-LIST-TO-SIGNATURE '(X))))
(SYSTEM::%PUTD 'FOO
(FUNCTION FOO
(LAMBDA (X) "doc" (DECLARE (SYSTEM::IN-DEFUN FOO)) (BLOCK FOO (PRINT X)))))
(EVAL-WHEN (EVAL)
(SYSTEM::%PUT 'FOO 'SYSTEM::DEFINITION
(CONS '(DEFUN FOO (X) "doc" (PRINT X)) (THE-ENVIRONMENT))))
'FOO)
SBCL does:
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL) (SB-C:%COMPILER-DEFUN 'FOO NIL T))
(SB-IMPL::%DEFUN 'FOO
(SB-INT:NAMED-LAMBDA FOO
(X)
"doc"
(BLOCK FOO (PRINT X)))
(SB-C:SOURCE-LOCATION)))
The point here is that defun has a lot "under the hood", and for a reason. setf fdefinition is, on the other hand, more of "what you see is what you get", i.e., no magic involved.
This does not mean that setf fdefinition has no place in a modern lisp codebase. You can use it, e.g., to implement a "poor man's trace" (UNTESTED):
(defun trace (symbol)
(setf (get symbol 'old-def) (fdefinition symbol)
(fdefinition symbol)
(lambda (&rest args)
(print (cons symbol args))
(apply (get symbol 'old-def) args))))
(defun untrace (symbol)
(setf (fdefinition symbol) (get symbol 'old-def))
(remprop symbol 'odd-def))

Elisp lambdas, quoting, and lexical-let

I'm trying to understand the following two snippets of code:
(defun make-adder1 (n) `(lambda (x) (+ ,n x)))
(defun make-adder2 (n) (lexical-let ((n n)) (lambda (x) (+ n x))))
These both seem to produce callables:
(funcall (make-adder1 3) 5) ;; returns 8
(funcall (make-adder2 3) 5) ;; returns 8
These both work. I have two main questions:
1) I don't understand the disparity in "quoting level" between the two approaches. In the first case, the lambda expression is quoted, which means the "symbol itself" is returned instead of the value. In the second case, it seems like the statement with the lambda will get evaluated, so the value of the lambda will be returned. Yet, these both work with funcall. When using funcall on a defun'ed function, it has to be quoted. Is lexical-let doing some kind of quoting automatically? Isn't this, kind of surprising?
2) Reading other posts on this topic, I'm given to understand that the first approach will break down under certain circumstances and deviate from what one would expect from working with lambdas and higher order functions in other languages, because elisp has dynamic scoping by default. Can someone give a concrete example of code that makes this difference apparent and explain it?
In the first example there is no variable n in the resulting function, which is just (lambda (x) (+ 3 x)). It does not need lexical binding because there is no free variable in the lambda, i.e., no variable that needs to be kept in a binding of a closure. If you don't need the variable n to be available, as a variable in uses of the function, i.e., if its value at function definition time (=3) is all you need, then the first example is all you need.
(fset 'ad1 (make-adder1 3))
(symbol-function 'ad1)
returns:
(lambda (x) (+ 3 x))
The second example creates what is, in effect, a function that creates and applies a complicated closure.
(fset 'ad2 (make-adder2 3))
(symbol-function 'ad2)
returns
(lambda (&rest --cl-rest--)
(apply (quote (closure ((--cl-n-- . --n--) (n . 3) t)
(G69710 x)
(+ (symbol-value G69710) x)))
(quote --n--)
--cl-rest--))
A third option is to use a lexical-binding file-local variable and use the most straightforward definition. This creates a simple closure.
;;; foo.el --- toto -*- lexical-binding: t -*-
(defun make-adder3 (n) (lambda (x) (+ n x)))
(fset 'ad3 (make-adder3 3))
(symbol-function 'ad3)
returns:
(closure ((n . 3) t) (x) (+ n x))
(symbol-function 'make-adder1)
returns:
(lambda (n)
(list (quote lambda)
(quote (x))
(cons (quote +) (cons n (quote (x))))))
(symbol-function 'make-adder2)
returns:
(closure (t)
(n)
(let ((--cl-n-- (make-symbol "--n--")))
(let* ((v --cl-n--)) (set v n))
(list (quote lambda)
(quote (&rest --cl-rest--))
(list (quote apply)
(list (quote quote)
(function
(lambda (G69709 x)
(+ (symbol-value G69709) x))))
(list (quote quote) --cl-n--)
(quote --cl-rest--)))))
(symbol-function 'make-adder3)
returns
(closure (t) (n) (function (lambda (x) (+ n x))))

How to transform this function into macro?

I have difficulties understanding the new macro system of Scheme. Somewhere along the path I began to write my "macro" as a function first, and then later apply it as a macro.
So my mission is to turn the following structure:
;; highlight-rules: rule id, color and the regexp matches
(define highlight-rules
`((important ,(with-esc "[1;33m") ("foo"
"bob"))
(unimportant ,(with-esc "[1;30m") ("case of unimport"))
(urgent ,(with-esc "[1;31m") ("urgents"))))
Into this kind of cond series with match strings compiled to regexpes:
;; just an example. `line` is an argument bound by the function application
(cond
((string-match (regexp ".*sudo:session.*") line)
(with-color *important* line))
(else line))
I have written a function that seems to do the trick:
;; (cdar highlight-rules) -> (colorstring list-of-rules)
(define (parse-highlight-rules rules)
;; aux function to do one 'class' of patterns
(define (class-of-rules colorstr rulelist)
(map (lambda (rule)
`((string-match ,(regexp rule)) (with-color ,colorstr line)))
rulelist))
(define (do-loop accumulator rules)
(let* ((highlight-group (cdar rules))
(colorstr (car highlight-group))
(grouprules (cadr highlight-group))
(acc* (append (class-of-rules colorstr grouprules) accumulator))
(rest (cdr rules)))
(if (null? rest)
acc*
(do-loop acc* rest))))
; wrap the list in cond.
`(apply cond ,(do-loop '() rules)))
With given highlight-rules the function returns correct-looking list (well apart from applying the apply -- in clojure one would use splicing):
CSI> (parse-highlight-rules highlight-rules)
(apply cond (((string-match #<regexp>) (with-color "\x1b[1;31m" line))
((string-match #<regexp>) (with-color "\x1b[1;30m" line))
((string-match #<regexp>) (with-color #0="\x1b[1;33m" line))
((string-match #<regexp>) (with-color #0# line))))
But how to proceed with this? I've been stuck with this for a while. Chicken Scheme is my dialect.
The easiest way of transforming your function into a macro is by using Chicken's explicit-renaming macro facility, which works similarly to Clojure's defmacro (except that an explicit-renaming macro takes some additional arguments that can be used to preserve hygiene).
Splicing works basically the same way as it does in Clojure. The syntax is ,#. Therefore, the following should work:
(define-for-syntax (parse-highlight-rules rules)
;; ... insert missing code here ...
`(cond ,#(do-loop '() rules)))
(define-syntax highlight
(er-macro-transformer
(lambda (form rename compare)
(parse-highlight-rules (cdr form)))))