I can define syntax for for loop this way:
(require syntax/parse/define)
(define-syntax-parser myfor
[(_ Binding Form1 ...)
#'(for (Binding) Form1 ...)]
)
(myfor (I (range 0 10))
(displayln I)
)
It works, but when I add keyword to it, it doesn't follow the condition in #:break keyword:
(require syntax/parse/define)
(define-syntax-parser myfor
[(_ Binding #:break Break Form1 ...)
#'(for (Binding) Form1 ...)]
)
(myfor (I (range 0 10))
#:break (= I 5)
(displayln I)
)
How to add keywords to define-syntax-parser the correct way?
There are two parts to this:
Accepting #:break in the input as an optional keyword
Producing #:break in the output when necessary
There are three approaches: multi-branch, optional, and syntax-class.
Multi-branch
The easiest way to solve this is by having two branches in the syntax-parser. One branch with the keyword, another branch without.
Two branches means two patterns to match on input, and two templates to produce output.
(define-syntax-parser myfor
[(_ Binding #:break Break Form1 ...)
#'(for (Binding #:break Break) Form1 ...)]
[(_ Binding Form1 ...)
#'(for (Binding) Form1 ...)])
This is fairly simple and straightforward, but has the disadvantage that you're repeating yourself, specifying for, Binding and Form1 ... multiple times for each branch, and it gets more verbose if you add more keywords.
Optional and ~?
Another way is by using ~optional and ~seq in the pattern to match input, while using ~? and ~# in the template to produce output.
(define-syntax-parser myfor
[(_ Binding {~optional {~seq #:break Break}} Form1 ...)
#'(for (Binding {~? {~# #:break Break}}) Form1 ...)])
Notice how ~? in the template is where ~optional was in the pattern, while ~# in the template is where ~seq was in the pattern.
This strategy is best when there's a clear symmetry between the input pattern and the output template.
Syntax-class
(begin-for-syntax
(define-splicing-syntax-class maybe-break-clause
[pattern {~seq} #:with (out ...) '()]
[pattern {~seq #:break Break} #:with (out ...) #'(#:break Break)]))
(define-syntax-parser myfor
[(_ Binding mbc:maybe-break-clause Form1 ...)
#'(for (Binding mbc.out ...) Form1 ...)])
This strategy is overkill in this case for #:break, but may become necessary if the keyword behavior is more complicated than simply passing a keyword if it exists.
I found out how, I need to add ~optional and ~seq to the syntax:
(require syntax/parse/define)
(define-syntax-parser myfor
[(_ Binding {~optional {~seq #:break Break} #:defaults [(Break #'#f)] } Form1 ...)
#'(for (Binding #:break Break) Form1 ...)]
)
(myfor (I (range 0 10))
#:break (= I 5)
(displayln I)
)
Related
I am trying to see how to rebind a lexical binding, or redefine the
closure of a lambda. The expected usage of next-noun is just to call it as many times as desired with no arguments. It should return a random noun from the list, but one that has not been returned yet until the list is exhausted.
Here is the toy example I am using:
#lang racket
(define nouns `(time
year
people
way
day
man))
(define (next-noun)
(let* ([lst-nouns (shuffle nouns)]
[func-syn
`(λ ()
(let* ([n (car lst-nouns)]
[lst-nouns (if (null? (cdr lst-nouns))
(shuffle nouns)
(cdr lst-nouns))])
(set! next-noun (eval func-syn))
n))])
((eval func-syn))))
When trying to run it I get this error:
main.rkt>
main.rkt> (next-noun)
; lst-nouns: undefined;
; cannot reference an identifier before its definition
; in module: "/home/joel/projects/racket/ad_lib/main.rkt"
Which confuses me since there should be a binding for lst-nouns any
time (eval func-syn) is run. What's going on?
You don't need to use eval here, at all. It's making the solution more complex (and insecure) than needed. Besides, the "looping" logic is incorrect, because you're not updating the position in lst-nouns, and anyway it gets redefined every time the procedure is called. Also, see the link shared by Sorawee to understand why eval can't see local bindings.
In Scheme we try to avoid mutating state whenever possible, but for this procedure I think it's justified. The trick is to keep the state that needs to be updated inside a closure; this is one way to do it:
(define nouns '(time
year
people
way
day
man))
; notice that `next-noun` gets bound to a `lambda`
; and that `lst-nouns` was defined outside of it
; so it's the same for all procedure invocations
(define next-noun
; store list position in a closure outside lambda
(let ((lst-nouns '()))
; define `next-noun` as a no-args procedure
(λ ()
; if list is empty, reset with shuffled original
(when (null? lst-nouns)
(set! lst-nouns (shuffle nouns)))
; obtain current element
(let ((noun (car lst-nouns)))
; advance to next element
(set! lst-nouns (cdr lst-nouns))
; return current element
noun))))
#PetSerAl proposed a more idiomatic solution in the comments. My guess is that you want to implement this from scratch, for learning purposes - but in real-life we would do something like this, using Racket's generators:
(require racket/generator)
(define next-noun
(infinite-generator
(for-each yield (shuffle nouns))))
Either way it works as expected - repeatedly calling next-noun will return all the elements in nouns until exhausted, at that point the list will be reshuffled and the iteration will restart:
(next-noun)
=> 'day
(next-noun)
=> 'time
...
You issue is with eval. eval does not have lexical environment from where it is called rather it has at most the top level bindings. Eg.
(define x 12)
(let ((x 10))
(eval '(+ x x))) ; ==> 24
eval is almost always the wrong solution and can often be replaced with closures and called directly or with apply. Here is what I would have done:
(define (shuffle-generator lst)
(define shuffled (shuffle lst))
(define (next-element)
(when (null? shuffled)
(set! shuffled (shuffle lst)))
(begin0
(car shuffled)
(set! shuffled (cdr shuffled))))
next-element)
(define next-int15 (shuffle-generator '(1 2 3 4 5)))
(define random-bool (shuffle-generator '(#t #f)))
(random-bool) ; ==> #f
(next-int15) ; ==> 5
(next-int15) ; ==> 4
(next-int15) ; ==> 2
(next-int15) ; ==> 1
(next-int15) ; ==> 3
(next-int15) ; ==> 3
(random-bool) ; ==> #t
(random-bool) ; ==> #t
The returned values are random so it's just what I got my first round. Instead of naming next-element one could simply just return the lambda, but the name gives information on what it does and the debugger will show the name. eg.:
next-int15 ; ==> #<procedure:next-element>
I'm somewhat new to CL and currently trying to wrap my head around mapcan, #', funcall and closures.
Here is a closure, which applies a predicate to a number n and, if correct, returns (list n), else nil:
(defun all-those (predicate)
(lambda (n)
(if (funcall predicate n) (list n))))
I understand that I need to call funcall to turn this closure into a function. This works fine:
> (funcall (all-those #'evenp) 8)
(8)
Now I tried to pass the hereby created function as an argument to mapcan:
> (mapcan #'(funcall (all-those #'evenp)) '(1 2 3 4))
I get a compile-time-error: (FUNCALL (ALL-THOSE #'EVENP)) is not a legal function name.
But it works if I omit #' as well as funcall:
> (mapcan (all-those #'evenp) '(1 2 3 4))
(2 4)
Now I'm confused. It was my understanding that I need to sharp-quote a function when using mapcan to follow the symbol's function binding (*) and that I need to call funcall when "closing a closure".
Is it because #' and funcall are cancelling each other out or why do I have to omit both of them in the above example? Thank you in advance for any replies.
(*) I know that in this example I don't really have a symbol whose function binding can be followed. But if I use an anonymous function and mapcan I still need to sharp-quote it: (mapcan #'(lambda ...
To mapcar, funcall, etc., you need to pass either a function object or a symbol. If you pass a symbol, then the symbol-function of the symbol is used as the function. If you pass a function object, then it is used as the function.
Your all-those function returns a function. That means that (mapcan (all-those …) …) is fine.
The sharp quote (#') is just shorthand for the function form. That is, #'foo is the same as (function foo):
The value of function is the functional value of name in the current
lexical environment.
If name is a function name, the functional definition of that name is
that established by the innermost lexically enclosing flet, labels, or
macrolet form, if there is one. Otherwise the global functional
definition of the function name is returned.
If name is a lambda expression, then a lexical closure is returned. In
situations where a closure over the same set of bindings might be
produced more than once, the various resulting closures might or might
not be eq.
So you only use #' or function with a function name. That means either a symbol (e.g., #'car) or a lambda expression (e.g., #'(lambda (x) x)). That means that the following doesn't work (or really make sense, even):
#'(funcall (all-those #'evenp))
Now I'm confused. It was my understanding that I need to sharp-quote a
function when using mapcan to follow the symbol's function binding (*)
and that I need to call funcall when "closing a closure".
The documentation for mapcar, etc., says that its first argument is:
function---a designator for a function that must take as many
arguments as there are lists.
From the glossary:
function designator n. a designator for a function; that 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). The consequences are undefined if a symbol
is used as a function designator but it does not have a global
definition as a function, or it has a global definition as a macro or
a special form. See also extended function designator.
So, you can pass a function directly to mapcar, funcall, etc., which is exactly what you're doing in:
(mapcan (all-those …) …)
You can also do:
(mapcan (lambda (x) ...) ...)
(mapcan #'(lambda (x) ...) ...)
(mapcan 'car ...)
(mapcan #'car ...)
(mapcan (symbol-function 'car) ...)
Summary
(function foo) is a special form, returning a function object. Here retrieved from the name foo. We use it to get a function object.
(funcall foo) is used to call functions passed as an argument - here the variable value of foo.
funcall = FUNction CALL = call a function.
We use it to call a function object.
Details
Here is a closure, which applies a predicate to a number n and, if correct, returns (list n), else nil:
(defun all-those (predicate)
(lambda (n)
(if (funcall predicate n) (list n))))
No, that's not a closure. all-those returns a closure, but itself it isn't one.
? #'all-those
#<Compiled-function ALL-THOSE #x302000C9631F>
? (all-those #'evenp)
#<COMPILED-LEXICAL-CLOSURE (:INTERNAL ALL-THOSE) #x302000E5ECFF>
I understand that I need to call funcall to turn this closure into a function.
A closure is a function object.
? (functionp (all-those #'evenp))
T
Note: all closures are also function objects. Not all function objects are closures.
A closure is a function and associated variable bindings. It is a function object.
Note that anonymous functions are not necessarily closures. (function (lambda () ())) does not return a closure, since there are no variable bindings. You could say that it is a closure with empty bindings, but in CL speak that's not called a closure.
Note that in standard Common Lisp there is no way to determine if a function object is actually a closure and there is no way to access its bindings via variable names.
I understand that I need to call funcall to turn this closure into a function.
funcall is used to call function objects (or function objects which it will retrieve from a symbol's function value) with arguments.
Remember, there are various ways to call a function:
call a named global function: (foo bar baz)
call a named lexical function: (foo bar bar)
call a named global function via a symbol: (funcall 'foo bar baz)
call a function object from a variable value: (funcall foo bar baz)
call a function object from a function name (lexical or global): (funcall #'foo bar baz)
call an anonymous function object: (funcall (function (lambda (foo) foo)) 'bar) or (funcall #'(lambda (foo) foo) 'bar) or (funcall (lambda (foo) foo) 'bar)
call an anonymous function: ((lambda (foo) foo) 'bar)
Then there is APPLY which is similar to FUNCALL but takes the arguments from a list.
(apply #'+ 1 2 3 (list 4 5 6)) is similar to (funcall #'+ 1 2 3 4 5 6)
FUNCALL itself is a function. All its argument forms will be evaluated. The first argument needs to evaluate to a symbol or a function object. funcall will call the function object (or the function object retrieved from the symbols's function value with arguments.
FUNCTION is a special operator. It is syntax. It is not a function itself. FUNCTION expects a symbol or a lambda expression as its subform. A FUNCTION form returns a function object, corresponding to the symbol (either from a global function or a lexical function) or to the lambda expression.
? (defun foo (bar) (list bar 'baz))
FOO
? (function foo) ; a function object from the global function
#<Compiled-function FOO #x302000CC0D1F>
? #'foo ; the same, differently written
#<Compiled-function FOO #x302000CC0D1F>
? (funcall #'foo 42) ; calling the function object
(42 BAZ)
? (funcall 'foo 42) ; calling the symbol-function of the symbol
(42 BAZ)
? (funcall (symbol-function 'foo) 42) ; as above
(42 BAZ)
? (flet ((foo (arg) (list arg :foo))) ; a local lexical function
(list (foo 43) ; calling the local lexical function
(funcall #'foo 42) ; calling a function object,
; from the local lexical function
(funcall 'foo 41))) ; calling the symbol-function of the symbol
((43 :FOO) (42 :FOO) (41 BAZ))
I am playing around with some declarative graphics stuff in Racket v6.5. For that I have defined a macro that executes a list of functions. This is then used in the drawing callback.
#lang racket/gui
(define-syntax-rule (execute-functions flist arg)
(for-each
(lambda (function)
[(function arg)])
flist))
(define-syntax-rule
(text str (at x y))
(lambda (dc)
(send dc set-scale 1 1)
(send dc set-text-foreground "blue")
(send dc draw-text str x y)))
(define-syntax-rule
(drawing items ...)
(lambda (dc) (execute-functions (list items ...) dc)))
(define my-drawing
(drawing (text "hi" (at 1 1)) (text "lo" (at 20 20))))
(define frame (new frame%
[label "Example"]
[width 300]
[height 300]))
(new canvas% [parent frame]
[paint-callback (lambda (canvas dc) (my-drawing dc))])
(send frame show #t)
The above progam will result in errors:
. . application: not a procedure;
expected a procedure that can be applied to arguments
given: #<void>
Which are traced to the function execution in drracket: (function arg).
If I check for void it works ok:
(define-syntax-rule (execute-functions flist arg)
(for-each
(lambda (function)
[if (void? function) void (function arg)])
flist))
But I am a bit concerned that it is being passed void in the first place as I don't know why that is. Is it something that is expected from a list of functions?
You have an extra set of parentheses (well, in this case square brackets, but they are equivalent) in the definition of your execute-functions macro.
(define-syntax-rule (execute-functions flist arg)
(for-each
(lambda (function)
[(function arg)])
; ^--------------^------- these brackets shouldn’t be here
flist))
The call itself, (function arg), may return #<void>, and the result is attempted to be invoked as a function itself (provided no arguments) since it is surrounded with parentheses/brackets, which denote function calls in Lisp/Scheme/Racket when used as expressions.
As a separate issue, though, your use of define-syntax-rule everywhere instead of simply using define is confusing to me and doesn’t seem to make much sense. These things do not need to be macros—always prefer functions over macros when you don’t need the syntax-transformation functionality of macros.
Functions are more flexible and can be used higher-order (that is, they can be passed as values), but macros cannot. Also, wanton use of macros will generate massive amounts of code, effectively forcing the compiler to inline every single “function call”. Use them when you need them, but you don’t need them here.
The execute-functions and drawing functions can be replaced with ordinary functions with barely any modification:
(define (execute-functions flist arg)
(for-each
(lambda (function)
(function arg))
flist))
(define (drawing . items)
(lambda (dc) (execute-functions items dc)))
The custom syntax for the text macro does not seem worth it to me at all, but if you really want it, then you might want to pull the functionality into a separate, ordinary function that the macro defers to instead:
(define ((text-proc str x y) dc)
(send dc set-scale 1 1)
(send dc set-text-foreground "blue")
(send dc draw-text str x y))
(define-syntax-rule (text str (at x y))
(text-proc str x y))
I wrote some function that could replace the function read of common lisp
(defun my-read (stream &rest args)
(declare (ignore args))
(funcall (my-get-macro-character (read-char stream))))
Is there a way to use this function as default reader?
You can't redefine the built in functions1, but you can define a package that shadows cl:read and defines a new function my:read, so that when you use that package, it looks like it's the default read function. E.g., something like this:
CL-USER> (defpackage #:my-package
(:use "COMMON-LISP")
(:shadow #:read)
(:export #:read))
;=> #<PACKAGE "MY-PACKAGE">
CL-USER> (defun my-package:read (&rest args)
(declare (ignore args))
42)
;=> MY-PACKAGE:READ
CL-USER> (defpackage #:another-package
(:use #:my-package "COMMON-LISP")
(:shadowing-import-from #:my-package #:read))
;=> #<PACKAGE "ANOTHER-PACKAGE">
CL-USER> (in-package #:another-package)
;=> #<PACKAGE "ANOTHER-PACKAGE">
ANOTHER-PACKAGE> (read)
;=> 42
Actually, as Rainer Joswig noted in the comments, even though it's undefined behavior (see 11.1.2.1.2 Constraints on the COMMON-LISP Package for Conforming Programs), there often are ways to redefine some of the Common Lisp function, For instance, in SBCL you can use unlock-package, as shown in redefining built-in function. CLISP has package locks. Other implementations may have similar functionality.
One approach is to use set-macro-character on all "valid" input characters in a readtable. (This is okay if you only accept ASCII input, but I don't know if it would be practical for full Unicode.)
Something like this:
(defun replace-default-read-behavior (rt fn)
(loop for c across
" !\"#$%&'()*+,-./0123456789:;<=>?#ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
do (set-macro-character c fn t rt)))
(defun my-parser (stream char)
(format t "custom read: ~A~A" char (read-line stream)))
(defun my-get-macro-character (char)
(declare (ignore char))
#'my-parser)
(defun my-read (stream char)
(funcall (my-get-macro-character char) stream char))
(defvar *my-readtable* (copy-readtable ()))
(replace-default-read-behavior *my-readtable* #'my-read)
(let ((*readtable* *my-readtable*))
(read-from-string "foo"))
custom read: foo ; printed
NIL ; returned
3
Is it possible in (Common) Lisp to jump to another function instead of call another?
I mean, that the current function is broken and another is called, without jumping back through thousands of functions, as if I'd decide myself if tail call optimization is done, even if it is not the tail.
I'm not sure if "(return-from fn x)" does, what I want.
Example:
(defun fn (x)
(when x
(princ x)
(jump 'fn (cdr x)))
(rest))
'jump' should be like calling the following function without saving the position of this function, instead returning to, where the original funcall was, so that there will be no stack overflow.
'rest' should only be executed if x is nil.
When you need a tail call optimization like structure in a language that doesn't (necessarily) provide it, but does provide closures, you can use a trampoline to achieve constant stack space (with a trade off for heap space for closure objects, of course). This isn't quite the same as what you asking for, but you might find it useful. It's pretty easy to implement in Common Lisp:
(defstruct thunk closure)
(defmacro thunk (&body body)
`(make-thunk :closure (lambda () ,#body)))
(defun trampoline (thunk)
(do ((thunk thunk (funcall (thunk-closure thunk))))
((not (thunk-p thunk)) thunk)))
To use the trampoline, you just call it with a thunk that performs the first part of your computation. That closure can either return another thunk, or a result. If it returns a thunk, then since it returned the initial stack frame is reclaimed, and then the closure of returned thunk is invoked. For instance, here's what an implementation of non-variadic mapcar might look like:
(defun t-mapcar1 (function list)
(labels ((m (list acc)
(if (endp list)
(nreverse acc)
(thunk
(m (rest list)
(list* (funcall function (first list)) acc))))))
(m list '())))
When the list is empty, we get an empty list immediately:
CL-USER> (t-mapcar1 '1+ '())
NIL
When it's not, we get back a thunk:
CL-USER> (t-mapcar1 '1+ '(1 2))
#S(THUNK :CLOSURE #<CLOSURE (LAMBDA #) {10033C7B39}>)
This means that we should wrap a call with trampoline (and this works fine for the base case too, since trampoline passes non-thunk values through):
CL-USER> (trampoline (t-mapcar1 '1+ '()))
NIL
CL-USER> (trampoline (t-mapcar1 '1+ '(1 2)))
(2 3)
CL-USER> (trampoline (t-mapcar1 '1+ '(1 2 3 4)))
(2 3 4 5)
Your example code isn't quite enough to be an illustrative example, but
(defun fn (x)
(when x
(princ x)
(jump 'fn (cdr x)))
(rest))
would become the following. The return provides the early termination from fn, and the thunk value that's returned provides the “next” computation that the trampoline would invoke for you.
(defun fn (x)
(when x
(princ x)
(return (thunk (fn (cdr x)))))
(rest))
How about you use a tail call?
(defun fn (x)
(if x
(progn
(princ x)
(fn (cdr x)))
(progn
(rest))))
It calls fn in a tail position. If an implementation provides tail call optimization, you won't get a stack overflow. If you don't want to rely on that, you would need to handle the problem in a non recursive way. There are no explicit 'remove this functions stack frame and then call function X' operators in Common Lisp.
Well, not really. I once did experiment with
(defmacro recurr (name bindings &body body)
(let* ((names (mapcar #'car bindings))
(restart (gensym "RESTART-"))
(temp1 (gensym))
(temp2 (gensym))
(shadows (mapcar (lambda (name) (declare (ignore name)) (gensym)) names)))
`(block ,name
(let ,bindings
(macrolet ((,name ,shadows
(list 'progn
(cons 'psetq
(loop
:for ,temp1 :in ',names
:for ,temp2 :in (list ,#shadows)
:nconcing (list ,temp1 ,temp2)))
(list 'go ',restart))))
(tagbody
,restart
(progn ,#body)))))))
and to be used like scheme's named-let, e.g.:
(recurr traverse ((list '(1 2 3 4)))
(if (null list) 'end
(traverse (cdr list))))
but:
The object defined (traverse in the example) is not a function, i.e., you cannot funcall or apply it
This kind of construct doesn't really cope with recursive structures (i.e., since no stack is kept, you cannot use it to traverse over arbitrary trees instead of sequences)
Another approach might be
(defmacro label (name (&rest bindings) &body body)
`(labels ((,name ,(mapcar #'first bindings) ,#body))
(,name ,#(mapcar #'second bindings))))
which actually addresses the points mentioned, but loses the "look ma, no stack space consing" property.