Comparison returns expected value call function directory, but it is not so at process on list - lisp

I am creating a simple elisp tester.
However, I am getting the wrong behavior (which I can not understand) as seen below.
I think that testers should return t test cases (:eq 'a 'a) and (:eq (return-symbol) 'a) naturally as my tester also precedes the following code. Actually it is not so.
The following code has been lengthened beyond necessity, but for the most part it is checking the obvious behavior.
I think that my tester should also return those expected return values.
Are there any good ideas?
Even explaining the reason for this behavior would be a help to improve my tester. I would appreciate it if you give me something.
;; return-symbol is always return 'a
(defun return-symbol ()
'a)
;; => return-symbol
;; operation check for return-symbol
(return-symbol)
;; => a
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; compare 'a and 'a by eq
(eq 'a 'a)
;; => t
;; compare 'a and 'a by equal
(equal 'a 'a)
;; => t
;; compare (return-symbol) and 'a by eq
(eq (return-symbol) 'a)
;; => t
;; compare (return-symbol) and (return-symbol) by eq
(eq (return-symbol) (return-symbol))
;; => t
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; comparison by funcalled eq
(funcall 'eq 'a 'a)
;; => t
(funcall 'eq (return-symbol) 'a)
;; => t
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; funcall with interned symbol
(funcall (intern "eq") 'a 'a)
;; => t
(funcall (intern "eq") (return-symbol) 'a)
;; => t
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; define universal comparison function
(defun multi-comp (key a b)
"KEY is funcname symbol such as :FUNCNAME"
(let ((funcname (replace-regexp-in-string "^:+" "" (symbol-name key))))
(funcall (intern funcname) a b)))
;; => multi-comp
;; operation check for multi-comp
(multi-comp :eq 'a 'a)
;; => t
(multi-comp :eq (return-symbol) 'a)
;; => t
(multi-comp :equal (return-symbol) 'a)
;; => t
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Define function to apply sequentially
(defun run-test (tests)
"TESTS is list such as (([str]TESTNAME ([sym]:FUNC [sexp]A [sexp]B))
([str]TESTNAME ([sym]:FUNC [sexp]A [sexp]B))...)"
(dolist (x tests)
(let* ((testname (car x))
(values (cadr x))
(key (nth 0 values))
(a (nth 1 values))
(b (nth 2 values)))
(if (multi-comp key a b)
(princ (format "%s is passed\n" testname))
(princ (format "%s is failed\n" testname))))))
;; => run-test
;; operation check of run-test
(run-test '(("eq1" (:eq 'a 'a))
("eq2" (:eq (return-symbol) (return-symbol)))
("equal1" (:equal 'a 'a))
("equal2" (:equal (return-symbol) 'a))
("equal3" (:equal (return-symbol) (return-symbol)))))
;; =>
;; eq1 is failed ; <= ??
;; eq2 is failed ; <= ??
;; equal1 is passed
;; equal2 is failed ; <= ??
;; equal3 is passed
;; nil

Your argument to run-test is evaluated once, so "eq1" sees 'a which is (quote a) (a list of length 2) which is, of course, fails under eq.
Similarly, (return-symbol) is not evaluated and "eq1" sees the lists of length 1 which are not identical under eq.
You would have discovered that by simply adding print to multi-comp.
Your code would probably work is you replace (multi-comp key a b) with (multi-comp key (eval a) (eval b)).
Please note that the fact that you need eval is a very strong indicator that you are doing something horribly wrong.
PS. I urge you to use ERT instead of rolling your own.

Related

How to call a referenced lambda?

I'm trying to call a function (lambda) stored within an alist. Below is a small snippet that demonstrates what I'm trying to do:
(defvar *db* '((:add (lambda (a b)
(+ a b)))
(:sub (lambda (a b)
(- a b)))))
(defun perform-operation-on-numbers (operation a b)
"Performs specified operation on the supplied numbers."
(let ((func (second (find operation
*db*
:key #'car))))
;; TODO: Call `func` on `a` and `b`
(print func)))
(perform-operation-on-numbers :add 1 2)
No matter what I do, not even funcall is able to let me call the lambda stored against :add. How should I reference the retrieved lambda as a lambda?
Your use of quote lead to your inability to use funcall.
Look:
(setf *mydb* '((:add #'+)
(:sub #'-)))
;; ((:ADD #'+) (:SUB #'-))
I can't use funcall. But:
(setf *mydb* (list (cons :add #'+)
(cons :sub #'-)))
;; ((:ADD . #<FUNCTION +>) (:SUB . #<FUNCTION ->))
;;
;; ^^^^ "FUNCTION" ? That's better! <----------
;;
I can (funcall (cdr (first *MYDB*)) 2)
Then the succinct notation is with back-quote and comma.
As pointed out by other answers, you are manipulating code as data, where the forms below (lambda ...) are unevaluated. But even with your data:
(defvar *db* '((:add (lambda (a b)
(+ a b)))
(:sub (lambda (a b)
(- a b)))))
You can use funcall or apply, if you first use COERCE:
If the result-type is function, and object is a lambda expression, then the result is a closure of object in the null lexical environment.
For example, let's access the form associated with :add:
CL-USER> (second (assoc :add *db*))
(LAMBDA (A B) (+ A B))
The value is an unevaluated form.
You can coerce it to a function:
CL-USER> (coerce (second (assoc :add *db*)) 'function)
#<FUNCTION (LAMBDA (A B)) {536B988B}>
Maybe you want to walk the terms to check that the lambda are only using a restricted set of operations, in which case it makes sense to keep them as data. But at some point you'll want to turn these code snippets to actual functions, and you can do that with coerce:
CL-USER> (defvar *db-fns*
(loop
for (n c) in *db*
collect (list n (coerce c 'function))))
*DB-FNS*
Here you compute the functions once, and can reuse them later instead of calling coerce each time.
CL-USER> *db-fns*
((:ADD #<FUNCTION (LAMBDA (A B)) {536B9B5B}>)
(:SUB #<FUNCTION (LAMBDA (A B)) {536B9C0B}>))
(it is equivalent to calling eval on the lambda form)
That's not a function: it's a list beginning (lambda ...). If you want a function have a function, for instance by
(defvar *db* `((:add ,(lambda (a b)
(+ a b)))
(:sub ,(lambda (a b)
(- a b)))))
or, better, don't wrap the thing in some useless baggage:
(defvar *db* `((:add ,#'+
(:sub ,#'-))

Using elisp symbol to implement call-by-reference, but can not get value from `symbol-value`

Emacs-lisp is default using call-by-value, but I'm trying use its symbol mechanism to simulate call-by-reference.
For example,
(setq lexical-binding nil)
(defun cbr (x)
(message "cbr (symbol-name x) %s" (symbol-name x))
(message "cbr (symbol-value x) %s" (symbol-value x))
(set x 2))
(let ((a 1))
(cbr 'a)
a)
;; cbr (symbol-name x) a
;; cbr (symbol-value x) 1
;; 2
It works well, because the result of let expression is 2, so it is indeed the call-by-reference behavior.
However, if I change the name from a to x:
(let ((x 1))
(cbr 'x)
x)
;; cbr (symbol-name x) x
;; cbr (symbol-value x) x
;; 1
Now it doesn't work as expected anymore.
Why?
Notice that it even can not get the correct symbol-name in cbr.
I think I have known what happen.
The second program returns 1, because the symbol x is captured by cbr's param x. When the body of cbr is evaluated, there are two bindings in the environment: one is the let binding x = 1, the other is x = x which is created by cbr's application. The symbol x in the (set x 2) uses the later one.
A workaround of this question is:
(let ((gen-x (gensym)))
(set gen-x 1)
(cbr gen-x)
(symbol-value gen-x))
;; cbr (symbol-name x) g36
;; cbr (symbol-value x) 1
;; 2
What should be clear from this is that relying on dynamic scope and symbol-value is a disaster: you need gensyms all over the place. Relying on dynamic scope for anything is generally a disaster, except in the specific, rare but extremely useful, case where you actually want dynamic scope.
But solving this problem trivial, even in elisp, with lexical scope. Here is one simple approach:
(defmacro ref (form)
;; Construct a reference to a form
(unless lexical-binding
(error "doomed"))
(let ((<setting> (gensym)))
`(lambda (&rest ,<setting>) ;hack for &optional (v nil vp)
(cond
((null ,<setting>)
,form)
((null (cdr ,<setting>))
(setf ,form (car ,<setting>)))
(t
(error "mutant"))))))
(defun ref-value (ref)
(funcall ref))
(defun set-ref-value (ref value)
;; should be (setf ref-value), but elisp
(funcall ref value))
And now, for instance, given:
(defun outer (v)
(let ((x 1))
(princ (format "x is first %s\n" x))
(inner (ref x) v)
(princ (format "and x is now %s\n" x))
x))
(defun inner (ref v)
(princ (format " ref is first %s\n" (ref-value ref)))
(set-ref-value ref v)
(princ (format " and ref is now %s\n" (ref-value ref))))
Then
ELISP> (outer 4)
x is first 1
ref is first 1
and ref is now 4
and x is now 4
4 (#o4, #x4, ?\C-d)

How to write LISP macro with double quasi quotation in scheme

I need to write the lisp macro in scheme (please on hygienic macros and syntax-rules etc) that will have function call and Alist as argument
I want function and macro that call that function to have syntax like this:
(foo '(10 (a (lambda () (display "10")) b (lambda () (display "20"))))
or macro without quotes.
My last code is working, but not sure if this is how you suppose to write function/macro like this. It seems that I need double backquote but don't know how to write it. (I'm right now reading On Lips by Paul Graham and he said that double backquote is very hard and only need by macros defining macros, but It seems that this is what I need).
(define (foo expr)
`(list ,(car expr)
(,(string->symbol "quasiquote") ,(pair-map (lambda (a b)
(cons (symbol->string a)
(list 'unquote b)))
(cadr expr)))))
(define-macro (bar expr)
(foo expr))
(define xx (bar (10 (a 20 b (lambda () (display "x") (newline))))))
;; (list 10 `((a . ,20) (b . ,(lambda () (display "x") (newline))))
(define bfn (cdr (assoc "b" (cadr xx)))))
(bfn)
;; "x"
and here is definition of pair-map
(define (pair-map fn seq-list)
"(seq-map fn list)
Function call fn argument for pairs in a list and return combined list with
values returned from function fn. It work like the map but take two items from list"
(let iter ((seq-list seq-list) (result '()))
(if (null? seq-list)
result
(if (and (pair? seq-list) (pair? (cdr seq-list)))
(let* ((first (car seq-list))
(second (cadr seq-list))
(value (fn first second)))
(if (null? value)
(iter (cddr seq-list) result)
(iter (cddr seq-list) (cons value result))))))))
with (string->symbol "quasiquote") I was able not to use double backquote, can this be written with double backquote/quasiquote? How this should look like?
I'm asking if this can be written different way so I can fix few issues in my own lisp interpreter (not sure if is working correctly but it seems that this final version works the same in guile).
I came up with shorter quasiquote version, but still it require inserting symbols:
(define (foo expr)
`(list ,(car expr)
(,'quasiquote ,(pair-map (lambda (a b)
`(,(symbol->string a) . (,'unquote ,b)))
(cadr expr)))))

How to pass lexical bindings of functions to 'eval' in Emacs Lisp?

In Emacs Lisp, lexical environment are represented by an alist, mapping symbols to their value. It can be passed to evaluators as a second argument of 'eval' function.
(eval '(+ 3 var)
'((var . 4)))
→ 7
However, I can't figure out how to pass functions, not variables,
to the evaluator.
For example, either of the following expressions shows an error.
(eval '(func 3)
'((func . (lambda (x) (+ 4 x)))))
→ error: (void-function func)
(eval '(func 3)
'((func . (closure (t) (x) (+ 4 x)))))
→ error: (void-function func)
Any help is appreciated.
How about this :
(eval '(apply func (list 3))
'((func . (lambda (x) (+ 4 x)))))
Here's how you can do it:
(defun my-eval (exp var-bindings fun-bindings)
(eval `(cl-flet ,(mapcar (lambda (x) (list (car x) `',(cdr x)))
fun-bindings)
(let ,(mapcar (lambda (x) (list (car x) `',(cdr x)))
var-bindings)
,exp))
t))
or, using eval's builtin support for var-bindings:
(defun my-eval (exp var-bindings fun-bindings)
(eval `(cl-flet ,(mapcar (lambda (x) (list (car x) `',(cdr x)))
fun-bindings)
,exp)
(or var-bindings t)))
[ BTW, note that it is not always true that in Emacs Lisp, lexical environment are represented by an alist: after byte-compilation, lexical variables don't have any name any more, they're stored on "the" stack and they're directly accessed via their position in the stack. ]

Any good way to declare unused variables in destructuring-bind?

I can't figure, is there any way to put something like _ in erlang, for "unused value" in destructuring-bind?
For example there we have something like that:
(destructuring-bind ((_SNIPPET
(_TITLE . title)
(_DESCRIPTION . description)
_RESOURCE-ID (_VIDEO-ID . video-id)))) entry
(declare (ignore
_SNIPPET _TITLE _DESCRIPTION _RESOURCE-ID _VIDEO-ID))
(list video-id title description)))
It'll be great not to put specific variable for every unused value, and write something like that:
(destructuring-bind ((_
(_ . title)
(_ . description)
(_ (_ . video-id)))) entry
(list video-id title description)))
Is there any way to get such behavior with standart destructuring-bind or any other standart macros? Or I have to use some ML-like pattern matching library, and if so - which one?
It's not possible with DESTRUCTURING-BIND (you can't use a variable more than once, some compiler will complain). You can enumerate the variables, _1, _2, ... But then you have to ignore each of them.
LOOP can do it:
CL-USER 23 > (loop for ((a b nil c) nil d) in '(((1 2 3 4) 5 6)
((1 2 3 4) 5 6))
collect (list a b c d))
((1 2 4 6) (1 2 4 6))
NIL is used as the wildcard variable.
You can reuse the LOOP macro:
(defmacro match-bind (pattern object &body body)
`(loop with ,pattern = ,object
while nil
finally (return (progn ,#body))))
CL-USER 37 > (match-bind ((a b nil c) nil d)
'((1 2 3 4) 5 6)
(list a b c d))
(1 2 4 6)
You can use some LET-MATCH from some library. For example: https://github.com/schani/clickr/blob/master/let-match.lisp
There are probably more fancy versions.
There's nothing built into the language for this. Rainer Joswig's answer points out that loop can do some destructuring, but it doesn't do nearly as much. In an earlier version of this answer, I suggested traversing the destructuring lambda list and collecting a list of all the symbols that begin with _ and adding a declaration to the form to ignore those variables. A safer version replaces each one with a fresh variable (so that there are no repeated variables), and ignores them all. Thus something like
(destructuring-bind (_a (_b c)) object
c)
would expand into
(destructuring-bind (#:g1 (#:g2 c)) object
(declare (ignore #:g1 #:g2))
c)
This approach will work OK if you're only using the "data-directed" described in 3.4.4.1.1 Data-directed Destructuring by Lambda Lists. However, if you're using "lambda-list-directed" approach described in 3.4.4.1.2 Lambda-list-directed Destructuring by Lambda Lists, where you can use lambda-list keywords like &optional, &key, etc., then things are much more complicated, because you shouldn't replace variables in some parts of those. For instance, if you have
&optional (_x '_default-x)
then it might be OK to replace _x with something, but not _default-x, because the latter isn't a pattern. But, in Lisp, code is data, so we can still write a macro that maps over the destructuring-lambda-list and replaces only in locations that are patterns. Here's somewhat hairy code that does just that. This takes a function and a destructuring lambda list, and calls the function for each pattern variable in the lambda list, along with the type of the argument (whole, required, optional, etc.).
(defun map-dll (fn list)
(let ((result '())
(orig list)
(keywords '(&allow-other-keys &aux &body
&key &optional &rest &whole)))
(labels ((save (x)
(push x result))
(handle (type parameter)
(etypecase parameter
(list (map-dll fn parameter))
(symbol (funcall fn type parameter)))))
(macrolet ((parse-keyword ((&rest symbols) &body body)
`(progn
(when (and (not (atom list))
(member (first list) ',symbols))
(save (pop list))
,#body)))
(doparameters ((var) &body body)
`(do () ((or (atom list) (member (first list) keywords)))
(save (let ((,var (pop list)))
,#body)))))
(parse-keyword (&whole)
(save (handle :whole (pop list))))
(doparameters (required)
(handle :required required))
(parse-keyword (&optional)
(doparameters (opt)
(if (symbolp opt)
(handle :optional opt)
(list* (handle :optional (first opt)) (rest opt)))))
(when (and (atom list) (not (null list))) ; turn (... . REST)
(setq list (list '&rest list))) ; into (... &rest REST)
(parse-keyword (&rest &body)
(save (handle :rest (pop list))))
(parse-keyword (&key)
(doparameters (key)
(if (symbolp key)
(handle :key key)
(destructuring-bind (keyspec . more) key
(if (symbolp keyspec)
(list* (handle :key keyspec) more)
(destructuring-bind (keyword var) keyspec
(list* (list keyword (handle :key var)) more)))))))
(parse-keyword (&allow-other-keys))
(parse-keyword (&aux)
(doparameters (aux) aux))
(unless (null list)
(error "Bad destructuring lambda list: ~A." orig))
(nreverse result)))))
Using this, it's pretty easy to write a destructuring-bind* that replaces each pattern variable beginning with _ with a fresh variable that will be ignored in the body.
(defmacro destructuring-bind* (lambda-list object &body body)
(let* ((ignores '())
(lambda-list (map-dll (lambda (type var)
(declare (ignore type))
(if (and (> (length (symbol-name var)) 0)
(char= #\_ (char (symbol-name var) 0)))
(let ((var (gensym)))
(push var ignores)
var)
var))
lambda-list)))
`(destructuring-bind ,lambda-list ,object
(declare (ignore ,#(nreverse ignores)))
,#body)))
Now we should look at the expansions it produces:
(macroexpand-1
'(destructuring-bind* (&whole (a _ . b)
c _ d
&optional e (f '_f)
&key g _h
&aux (_i '_j))
object
(list a b c d e f g)))
;=>
(DESTRUCTURING-BIND
(&WHOLE (A #:G1041 &REST B) C #:G1042 D
&OPTIONAL E (F '_F)
&KEY G #:G1043
&AUX (_I '_J))
OBJECT
(DECLARE (IGNORE #:G1041 #:G1042 #:G1043))
(LIST A B C D E F G))
We haven't replaced anywhere we shouldn't (init forms, aux variables, etc.), but we've taken care of the places that we should. We can see this work in your example too:
(macroexpand-1
'(destructuring-bind* ((_ (_ . title)
(_ . description)
_
(_ . video-id)))
entry
(list video-id title description)))
;=>
(DESTRUCTURING-BIND ((#:G1044 (#:G1045 &REST TITLE)
(#:G1046 &REST DESCRIPTION)
#:G1047
(#:G1048 &REST VIDEO-ID)))
ENTRY
(DECLARE (IGNORE #:G1044 #:G1045 #:G1046 #:G1047 #:G1048))
(LIST VIDEO-ID TITLE DESCRIPTION))