LISP break a function execution - lisp

How can I break a function execution in LISP if I get a certain value?
For example, I have a main function like this:
(defun recognize-a (arg input)
(if (equal (recognize-b arg input) '())
T
NIL
))
I want to break the function recognize-b in case the input is an empty list, without passing any values to the main function:
(defun recognize-b (fa input)
(if (equal input '())
<<<WANTED BREAK>>>
(<Else branch>)))

You can use ERROR to signal an error from RECOGNIZE-B when INPUT is empty.
(defun recognize-b (arg input)
(when (emptyp input)
(error "INPUT is empty!"))
;; Do whatever the function normally does...
:return-value-from-b)
I'll just return :RETURN-VALUE-FROM-B since I don't know what the function is supposed to do. You could define an error type to signal, but by default ERROR will signal a SIMPLE-ERROR.
To handle the error in RECOGNIZE-A, you can use HANDLER-CASE.
(defun recognize-a (arg input)
(handler-case (recognize-b arg input)
(simple-error () t)))
This simply returns the value from RECOGNIZE-B if there was no error, or T if there was.
(recognize-a 10 '(1 2)) ;=> :RETURN-VALUE-FROM-B
(recognize-a 10 '()) ;=> T
There is a good introduction to the condition system in the book Practical Common Lisp, Chapter 19. Beyond Exception Handling: Conditions and Restarts.

Related

In common lisp how do you restart where the error was thrown not caught?

This question is really about my lack of understanding of restarts.
In the encoder for cl-json there exists a tempting macro I would like to use
with-substitute-printed-representation-restart
But alas I do not quite understand how.
This
(cl-json::encode-json-plist (list :boo "boo" :foo "foo"))
returns
{"boo":"boo","foo":"foo"}
This
(cl-json::encode-json-plist (list :boo "boo" :foo (lambda (a b) (+ a b))))
signals an UNENCODABLE-VALUE-ERROR
I would like to restart from that point where cl-json finds the function and have it return
something of my choosing when it runs into that adding lambda I included in the list.
(defun my-func ()
(handler-bind ((cl-json::UNENCODABLE-VALUE-ERROR
#'(lambda (e) (invoke-restart 'return-default))))
(myencode (list :boo "boo" :foo (lambda (a b) (+ a b))))
)
)
(defun myencode (alist)
(restart-case
(cl-json::encode-json-plist-to-string alist)
(return-default () :report "Just return a default could not do this string" "barf")
)
)
returns "barf"
I want it to return
{"boo":"boo","foo":"barf"}
How do I use that macro do to this?
In other words I want the restart to happen where the error was thrown not where the error was caught. Can I do that?
I don't understand if the doc is wrong or if I am reading the code badly, but there should already be a restart available whenever an object cannot be encoded. If you redefined cl-json default method for encode-json as follows, then you have a restart.
(defmethod encode-json (anything &optional (stream *json-output*))
"If OBJECT is not handled by any specialized encoder signal an error
which the user can correct by choosing to encode the string which is
the printed representation of the OBJECT."
(with-substitute-printed-representation-restart (anything stream)
(unencodable-value-error anything 'encode-json)))
By the way you could redefine so that the restart accepts an argument, the string to print instead:
(defmethod encode-json (anything &optional (stream *json-output*))
"If OBJECT is not handled by any specialized encoder signal an error
which the user can correct by choosing to encode the string which is
the printed representation of the OBJECT."
(with-substitute-printed-representation-restart (anything stream)
(restart-case (unencodable-value-error anything 'encode-json)
(use-value (v)
:report "Use a different encoding"
(check-type v string)
(write v :stream stream :escape t)))))
For example:
CL-USER> (handler-bind
((json:unencodable-value-error
(lambda (err)
(declare (ignore err))
(invoke-restart 'use-value "UNKNOWN"))))
(json:encode-json
`(((foo . ,#'print) (bar . "baz")))))
[{"foo":"UNKNOWN","bar":"baz"}]
You may want to ask directly the author of the library

How to pass a symbol of a condition of a function to a macro

I'm trying to pass a symbol of a condition of a function to a macro, and see the result:
(defmacro macro-test-1 (form condition)
`(handler-case (funcall ,form)
(,condition (c)
(declare (ignore c))
(format t "~a" 'why?))))
(macro-test-1 #'(lambda () (error 'simple-type-error)) division-by-zero)
;; OK, I get the simple-type-error as expected.
(defun test-1 (condition)
(macro-test-1 #'(lambda () (error 'simple-type-error)) condition))
; in: DEFUN TEST-1
; (SB-INT:NAMED-LAMBDA TEST-1
; (CONDITION)
; (BLOCK TEST-1
; (MACRO-TEST-1 #'(LAMBDA () (ERROR 'SIMPLE-TYPE-ERROR)) CONDITION)))
;
; caught STYLE-WARNING:
; The variable CONDITION is defined but never used.
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
TEST-1
;; what happened?
(test-1 'division-by-zero)
WHY?
NIL
;; what happened?
I'm pretty confused by what's going on, I've been trying to figure it out for a long time, I hope I'm missing something silly.
up 1
It is as I imagined, silly error, now I realized what I was trying to do, the macro will be expanded at compile time, and the argument I pass to the function at runtime, so the macro will not receive the condition argument correctly. So I see two possibilities of solving this, turning macro-test-1 into a function or turning test-1 into a macro.
Actually I tested here, changing to function still not working:
CL-USER> (defun macro-test-1 (form condition)
(handler-case (funcall form)
(condition (c)
(declare (ignore c))
(format t "~a" 'why?))))
; in: DEFUN MACRO-TEST-1
; (SB-INT:NAMED-LAMBDA MACRO-TEST-1
; (FORM CONDITION)
; (BLOCK MACRO-TEST-1
; (HANDLER-CASE (FUNCALL FORM)
; (CONDITION (C) (DECLARE #) (FORMAT T "~a" 'WHY?)))))
;
; caught STYLE-WARNING:
; The variable CONDITION is defined but never used.
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
WARNING: redefining COMMON-LISP-USER::MACRO-TEST-1 in DEFUN
CL-USER> (macro-test-1 #'(lambda () (error 'simple-type-error)) 'division-by-zero)
WHY?
NIL
However when you redefine macro-test-1 as a macro, and redefine test-1 as a macro:
CL-USER> (defmacro test-1 (condition)
`(macro-test-1 #'(lambda () (error 'simple-type-error)) ,condition))
TEST-1
CL-USER> (test-1 division-by-zero)
; Evaluation aborted on #<SIMPLE-TYPE-ERROR {1001BB8FF3}>.
I'm still not sure why the function does not work, the evaluation rule is not to evaluate all arguments and then pass to the body of the function the evaluated arguments? Because it does not work?
up 2
I understand that the handler-case does not work because you need to know the errors at compile time, and passing condition as a runtime function argument would not be able to know the compile-time error, so it does not work. And I stress this single reason, and not because macros occur has compile time, by a question I noted below which led me to this whole mess, and made me believe it is possible to pass condition by a function. I can do this:
(defmacro macro-test-1 (fn value)
`(funcall ,fn ,value 1))
(macro-test-1 #'= 1)
;; => T it is OK
(defun test-1 (fn value)
(macro-test-1 fn value))
(test-1 #'= 1)
;; => why it is OK?
The above code works, even though I pass the arguments to the function at runtime, why does it work? if the macro is expanded at compile time, why is it working when I call test-1? or are macros not always expanded at compile time? What am I missing here?
up 3
I decided to go deeper, and tried:
(defmacro macro-test-1 (fn value)
`(,fn ,value 1))
(macro-test-1 = 1)
;; => T it is OK
(defun test-1 (fn value)
(macro-test-1 fn value))
; in: DEFUN TEST-1
; (SB-INT:NAMED-LAMBDA TEST-1
; (FN VALUE)
; (BLOCK TEST-1 (MACRO-TEST-1 FN VALUE)))
;
; caught STYLE-WARNING:
; The variable FN is defined but never used.
; in: DEFUN TEST-1
; (MACRO-TEST-1 FN VALUE)
; ==>
; (FN VALUE 1)
;
; caught STYLE-WARNING:
; undefined function: FN
;
; compilation unit finished
; Undefined function:
; FN
; caught 2 STYLE-WARNING conditions
WARNING: redefining COMMON-LISP-USER::TEST-1 in DEFUN
TEST-1
Yes I know that if I try as shown below, it will not exit as expected:
(test-1 '= 1)
; Evaluation aborted on #<UNDEFINED-FUNCTION FN {1004575323}>. ;
But I wanted to find a way to make it work, so I tried, until I could, by resetting macro-test-1 to:
(defmacro macro-test-1 (fn value)
`(eval (,fn ,value 1)))
WARNING: redefining COMMON-LISP-USER::MACRO-TEST-1 in DEFMACRO
MACRO-TEST-1
(defun test-1 (fn value)
(macro-test-1 fn value))
WARNING: redefining COMMON-LISP-USER::TEST-1 in DEFUN
TEST-1
(test-1 '= 1)
T
Of course this would only work in handler-case or case, if I redefined its macros, which I believe should not be a good practice, nor do I need it, but I like to go where it does not, well, then, I learn erring.
Macros are code transformation. Thus the expansion can happen as early as when you evaluate a defun. eg.
(defun test-1 (condition)
(macro-test-1 #'(lambda () (error 'simple-type-error)) condition))
;; becomes this
(defun test-1 (condition)
(handler-case (funcall #'(lambda nil (error 'simple-type-error)))
(condition (c)
(declare (ignore c)) (format t "~a" 'why?)))
Now just lets say you want to have handler-case check for simple-type-error. You'll write it like this:
(handler-case expression
(simple-type-error ()
(format t "~a" 'why?)))
not
(handler-case expression
('simple-type-error ()
(format t "~a" 'why?)))
Eg. handler-case is syntax and that place is can not have a variable be evaluated to some error, but must be a type specifier and that is probably handled compile time by the system. This is the reason you get that condition is never used since your handler-case checks for a type called condition, not what you sent as the condition argument.
Making test-1 a macro actually passes division-by-zero as the symbol to macro-test-1 and the result is this:
(handler-case (funcall #'(lambda nil (error 'simple-type-error)))
(division-by-zero (c)
(declare (ignore c))
(format t "~a" 'why?)))
This also means the errors need to be known compile time since you cannot have a macro be passed values in variables. That is why it works so the second you want some user to input what error to act on you cannot do it with your solution.
EDIT
In up2 you ask why this works:
(defun test-1 (fn value)
(macro-test-1 fn value))
So we'll just find out what actually gets saved:
(macroexpand-1 '(macro-test-1 fn value))
; ==> (funcall fn value)
; ==> t
Thus your function becomes this:
(defun test-1 (fn value)
(funcall fn value))
handler-case was syntax that didn't take variables or expression at the place you wanted and thats why that didn't work, but it will of course work for all functions, including funcall, since it evaluates all it's arguments.
To show you a different example of what does not work is case:
(defun check-something (what result default-value value)
(case value
(what result)
(otherwise default-value)))
case is a macro so what actually happens. We can do macroexpand-1 on it to see:
(macroexpand-1
'(case value
(what result)
(otherwise default-value))
)
; ==> (let ((tmp value))
; (cond ((eql tmp 'what) result)
; (t default-value)))
; ==> t
The macro expects the case values to be literals and thus quotes them so that they never get evaluated. The resulting function you clearly see what is never used, just as condition wasn't:
(defun check-something (what result default-value value)
(let ((tmp value))
(cond ((eql tmp 'what) result)
(t default-value))))
Macros are to abstract on syntax. You need to be able to write the code without the macro and rather see that this is a pattern that repeats and than add an abstraction that rewrites from your simplified version to the full version. If it cannot be done to begin with it cannot be rewritten as a macro.
Same for functions. The whole reason why we have macros is to control evaluation. A good example of something that cannot be written as a fucntion is if:
(defun my-if (predicate consequence alternative)
(cond (predicate consequence)
(t alternative)))
(my-if t 'true 'false) ; ==> true
(my-if nil 'true 'false) ; ==> false
But since functions always evaluates their arguments you cannot do this:
(defun factorial (n)
(my-if (<= n 1)
1
(* n (factorial (1- n)))))
This will never halt since being a function all 3 arguments are always evalaued and (* n (factorial (1- n)))) is done even when n is negative and it will have endless recursion. Using a macro instead would replace the my-if with the resulting cond and both cond and if does not evaluate all their arguments rather than short circuits on the one that matches truthy predicate.
You may use macroexpand-1 to check if you code indeed is correct. You should be able to replace the input with the ourput. Is you use macroexpand applies the expansion until it will not expand anymore. Eg. cond will also be expanded to nested if's.
EDIT 2
From up3:
(defun test-1 (fn value)
(macro-test-1 fn value))
This is the same problem. The macro function gets fn and value as bindings and the result is:
(defun test-1 (fn value)
(fn value))
This might have worked in Scheme, but in Common Lisp symbols in operator prosition is different from other positions. Thus when CL tries to find the function fn it never look any close to the variable fn. The only way to solve this is by using funcall and then you actually don't need a macro at all:
(defun with-1 (fn value)
(funcall fn value 1))
(with-1 #'+ 10) ; ==> 11
Notice the #' prefix. That is short for (function ...) so it's really (function +). function is a special form that takes the argument symbol and gets the value from the function namespace.
With eval you can do a lot of stuff, but it comes with a price. It will not be optimized and perhaps even just interpreted and it might gove you compile time errors at runtime as well as open for security risks. A good example was a online interactive ruby that just did eval and it worked well until someone evaluated code that deleted all the system files. eval is considered harmful and even evil. In my professional career I have seen eval being used 3 times on purpose. (2 times in PHP, one in requirejs). One of those times I challenged the writer that there might be a better way to do it. Of course both handler-case and case will work with eval since the evaluated code would have the correct format, but you'll loose the lexical scoping. eg.
(let ((x 10))
(eval '(+ x 1)));
; *** EVAL: variable X has no value
You might be smart and do this:
(let ((x 10))
(eval `(+ ,x 1))) ; ==> 11
but what if it was a list or something else not self evaluating?
(let ((x '(a b)))
(eval `(cons '1 ,x)))
; *** undefined function: a
Thus eval has its chalenges as well. Keep away for other purposes than education ones.

parameter evaluation of function call from a macro

I have a function and one macro in which the function is called.
And to see the difference, I trace the function and found that there was no difference whether it is called directly or from the macro.
I wonder why the parameter was not evaluated when called from macro.
I know that parameters passed to a macro will not be evaluated but even this happens to the parameters passed to a function from a macro?
To be specific, I mean why (< 7 5) is not evaluated to nil when passed to gen-lisp
The function:
(defun gen-lisp (expr binds)
expr)
The macro:
(defmacro dsptch-prove-query (query binds)
`(if (eq (car ',query) 'lisp)
,(gen-lisp (cadr query) binds)
(prove-query ',query ,binds)))
Result when called from macro:
(dsptch-prove-query (lisp (< 7 5)) nil)
1. Trace: (GEN-LISP '(< 7 5) 'NIL)
1. Trace: GEN-LISP ==> (< 7 5)
NIL
Result when called directly:
(gen-lisp '(< 7 5) 'NIL)
1. Trace: (GEN-LISP '(< 7 5) 'NIL)
1. Trace: GEN-LISP ==> (< 7 5)
(< 7 5)
And if I just do it like this below, it is evaluated to nil already.
(gen-lisp (< 7 5) nil)
1. Trace: (GEN-LISP 'NIL 'NIL)
1. Trace: GEN-LISP ==> NIL
NIL
Your macro is:
(defmacro dsptch-prove-query (query binds)
`(if (eq (car ',query) 'lisp)
,(gen-lisp (cadr query) binds)
(prove-query ',query ,binds)))
The macro calls the function gen-lisp. The arguments are computed by (cadr query) and binds. query is a list. (cadr query) computes the second element of that list. That's the evaluation going on. There is no reason why it should evaluate the result of (cadr query).
Remember: macros are getting source code passed. They compute with code.
Just passing the code around does not evaluate the code.
Your macro calls the function gen-lisp at macro-expansion time in order to compute a part of the macro-expansion.
The expression which calls the function is this:
(gen-lisp (cadr query) binds)
this is a function call, which specifies two argument expressions: (cadr query) and binds. These expressions most certainly are evaluated as forms and their resulting values constitute the arguments which the function receives.
The macro's query parameter's argument value is the nested list object (lisp (< 7 5)) and so (cadr query) calculates the object (< 7 5). Of course this itself isn't evaluated as a form. Evaluation is done, and (< 7 5) is its result, which gets passed into the function as its leftmost argument.
What's going on inside the macro is very similar to this:
(let ((query '(lisp (< 7 5))) ;; analogous to macro's query param
(binds nil))
(gen-lisp (cadr query) binds)) ;; of course (< 7 5) not evaled
If (< 7 5) were reduced to nil, that would be a double evaluation. Nothing in the code calls for a double evaluation. (For instance, we do not see any direct or indirect use of the eval function which could request that extra evaluation).
gen-lisp returns whatever argument it receives.
As a function, it does not evaluate its arguments.
If you want the argument to be evaluated, you should turn it into a macro (which you would probably want to do anyway when you start to use the binds argument in non-trivial way)

Call several functions with the same value

I have various functions and I want to call each function with the same value. For instance,
I have these functions:
(defun OP1 (arg) ( + 1 arg) )
(defun OP2 (arg) ( + 2 arg) )
(defun OP3 (arg) ( + 3 arg) )
And a list containing the name of each function:
(defconstant *OPERATORS* '(OP1 OP2 OP3))
So far, I'm trying:
(defun TEST (argument) (dolist (n *OPERATORS*) (n argument) ) )
I've tried using eval, mapcar, and apply, but these haven't worked.
This is just a simplified example; the program that I'm writing has eight functions that are needed to expand nodes in a search tree, but for the moment, this example should suffice.
Other answers have provided some idiomatic solutions with mapcar. One pointed out that you might want a list of functions (which *operators* isn't) instead of a list of symbols (which *operators* is), but it's OK in Common Lisp to funcall a symbol. It's probably more common to use some kind of mapping construction (e.g., mapcar) for this, but since you've provided code using dolist, I think it's worth looking at how you can do this iteratively, too. Let's cover the (probably more idiomatic) solution with mapping first, though.
Mapping
You have a fixed argument, argument, and you want to be able to take a function function and call it with that `argument. We can abstract this as a function:
(lambda (function)
(funcall function argument))
Now, we want to call this function with each of the operations that you've defined. This is simple to do with mapcar:
(defun test (argument)
(mapcar (lambda (function)
(funcall function argument))
*operators*))
Instead of operators, you could also write '(op1 op2 op3) or (list 'op1 'op2 'op3), which are lists of symbols, or (list #'op1 #'op2 #'op3) which is a list of functions. All of these work because funcall takes a function designator as its first argument, and a function designator is
an object that denotes a function and that is one of: a symbol (denoting the function named by that symbol in the global environment), or a function (denoting itself).
Iteratively
You can do this using dolist. The [documentation for actually shows that dolist has a few more tricks up its sleeve. The full syntax is from the documentation
dolist (var list-form [result-form]) declaration* {tag | statement}*
We don't need to worry about declarations here, and we won't be using any tags, but notice that optional result-form. You can specify a form to produce the value that dolist returns; you don't have to accept its default nil. The common idiom for collecting values into a list in an iterative loop is to push each value into a new list, and then return the reverse of that list. Since the new list doesn't share structure with anything else, we usually reverse it destructively using nreverse. Your loop would become
(defun test (argument)
(let ((results '()))
(dolist (op *operators* (nreverse results))
(push (funcall op argument) results))))
Stylistically, I don't like that let that just introduces a single value, and would probably use an &aux variable in the function (but this is a matter of taste, not correctness):
(defun test (argument &aux (results '()))
(dolist (op *operators* (nreverse results))
(push (funcall op argument) results)))
You could also conveniently use loop for this:
(defun test2 (argument)
(loop for op in *operators*
collect (funcall op argument)))
You can also do somewhat succinctly, but perhaps less readably, using do:
(defun test3a (argument)
(do ((results '() (list* (funcall (first operators) argument) results))
(operators *operators* (rest operators)))
((endp operators) (nreverse results))))
This says that on the first iteration, results and operators are initialized with '() and *operators*, respectively. The loop terminates when operators is the empty list, and whenever it terminates, the return value is (nreverse results). On successive iterations, results is a assigned new value, (list* (funcall (first operators) argument) results), which is just like pushing the next value onto results, and operators is updated to (rest operators).
FUNCALL works with symbols.
From the department of silly tricks.
(defconstant *operators* '(op1 op2 o3))
(defun test (&rest arg)
(setf (cdr arg) arg)
(mapcar #'funcall *operators* arg))
There's a library, which is almost mandatory in any anywhat complex project: Alexandria. It has many useful functions, and there's also something that would make your code prettier / less verbose and more conscious.
Say, you wanted to call a number of functions with the same value. Here's how you'd do it:
(ql:quickload "alexandria")
(use-package :alexandria)
(defun example-rcurry (value)
"Calls `listp', `string' and `numberp' with VALUE and returns
a list of results"
(let ((predicates '(listp stringp numberp)))
(mapcar (rcurry #'funcall value) predicates)))
(example-rcurry 42) ;; (NIL NIL T)
(example-rcurry "42") ;; (NIL T NIL)
(defun example-compose (value)
"Calls `complexp' with the result of calling `sqrt'
with the result of calling `parse-integer' on VALUE"
(let ((predicates '(complexp sqrt parse-integer)))
(funcall (apply #'compose predicates) value)))
(example-compose "0") ;; NIL
(example-compose "-1") ;; T
Functions rcurry and compose are from Alexandria package.

While Loop Macro in DrRacket

I am trying to create a macro for while loop in DrRacket. Here is what I wrote:
(require mzlib/defmacro)
(define-macro my-while
(lambda (condition body)
(list 'local (list (list 'define (list 'while-loop)
(list 'if condition
(list body (list 'while-loop))
'(void))))
'(while-loop))))
(define x 0)
(my-while (< x 10)
(begin
(display x)
(newline)
(set! x (+ x 1))))
The output of this program is:
0
1
2
3
4
5
6
7
8
9
error: procedure application: expected procedure, given: #<void>; arguments were: #<void>
Can someone help me with this? Why wouldn't this macro just terminate and return void. It seems that when the condition is not true, the system tries to apply the void as an argument to some procedure.
Ouch:
Using this style of while loop encourages excessive use of imperative programming.
Using define-macro creates unhygienic macros, which is a nightmare in Scheme.
While I don't encourage writing an imperative-style loop macro, for your reference, here's a non-define-macro version of the same macro:
(define-syntax-rule (my-while condition body ...)
(let loop ()
(when condition
body ...
(loop))))
It uses syntax-rules, which creates hygienic macros, and is much, much easier to read than what you have.
Now, for the actual answer for your question, first, let's write your original macro out in a more readable way:
(define-macro my-while
(lambda (condition body)
`(local ((define (while-loop)
(if ,condition
(,body (while-loop))
(void))))
(while-loop))))
Once you write it out this way, you can see where the real problem is: in the (,body (while-loop)) line, which should instead have been (begin ,body (while-loop)).
Why use a macro when a plain old function will do?
;; fun-while : (-> Boolean) (-> Any) -> Void
(define (fun-while condition body)
(when (condition)
(body)
(fun-while condition body))
Of course, this requires you to pass in repeatable actions that can be called (this is why condition and body are surrounded with parens in the body of fun-while), so you do need a macro if you want prettier syntax. But once you have a function that has the desired behavior, putting some sugar on top is trivial for this case:
(define-syntax-rule (my-while condition body ...)
(fun-while (lambda () condition)
(lambda () body ...)))
Now, as has been said, this encourages imperative style, which is frowned upon. Instead of mutation, try making the state explicit instead:
;; pure-while : forall State.
;; (State -> Boolean) ; the "condition" that inspects the state
;; (State -> State) ; the "body" that moves from one state to the next
;; -> ; curried
;; State ; the current state
;; -> State ; produces the ending state
(define ((pure-while condition make-next) current-state)
(if (condition current-state)
(pure-while condition make-next (make-next current-state))
current-state))
You'll notice that the first two arguments are now functions from State to something, and the result of applying to 2 arguments is also a function from State -> State. This is a recurring pattern that, as a Haskeller, I'd call the "State Monad". Discussion of putting sugar on top of this concept is a little beyond the scope of this conversation, though, so I'll just stop there.
Another version of while uses a do loop:
(define-syntax while
(syntax-rules ()
((while pred? stmt ...)
(do () ((not pred?))
stmt ...))))
Because it's been a while:
a while macro for Racket 6.0
#lang racket
(define-syntax while
(syntax-rules ()
((_ pred? stmt ...)
(do () ((not pred?))
stmt ...))))