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
Related
I wanted to try meta-sexp package. It's a PEG-like parser library. Now, it has a method create-parser-context which can only take string or string-stream. (This is where the parsed content comes from.) However, open and friends create file-stream.
I've looked into flexi-streams library, but couldn't find a straight-forwad way to do it (I could use octets-to-string to create a buffer, feeding it to a bidirectional stream etc... but it's a lot of plumbing). I feel like I'm missing something obvious, and it should be as easy as calling some flexi-stream wrapper function.
I think that you do need to work with the way of transforming streams from the system meta-sexp readme:
meta-sexp uses in-memory string vectors, instead of commonly used
streams, for efficiently stepping backward and forward through the
input.
So meta-sexp works normally with characters and strings, it has implemented some type checkers:
CL-USER> (ql:quickload :meta-sexp)
To load "meta-sexp":
Install 1 Quicklisp release:
meta-sexp
Downloading http://beta.quicklisp.org/archive/meta-sexp/2010-10-06/meta-sexp-0.1.6.tgz
##########################################################################
; Loading "meta-sexp"
[package meta-sexp]......
(:META-SEXP)
CL-USER> (use-package :meta-sexp)
T
CL-USER> (alpha? #\c)
T
CL-USER> (alpha? #\3)
NIL
CL-USER> (digit? #\3)
3 (2 bits, #x3, #o3, #b11)
Then you can use this defining rules to work with strings like the example in the readme:
CL-USER> (defrule integer? (&aux (sign 1) d (num 0)) ()
(:? (:or (:and "-" (:assign sign -1))
"+"))
(:+ (:assign d (:type digit?))
(:assign num (+ (* num 10)
(- (char-code d) #.(char-code #\0)))))
(:return (* sign num)))
CL-USER> (defrule integer? (&aux (sign 1) d (num 0)) ()
(:? (:or (:and "-" (:assign sign -1))
"+"))
(:+ (:assign d (:type digit?))
(:assign num (+ (* num 10)
(- (char-code d) #.(char-code #\0)))))
(:return (* sign num)))
now let's suppose that we have this file
parser-test.txt:
patata
123
calimero
34
32
we can read as follows (read-line returns a string):
CL-USER> (with-open-file (stream "parser-test.txt")
(loop for line = (read-line stream nil)
while line
do (print line)))
"patata"
"123"
"calimero"
"34"
"32"
NIL
then apply the parser:
CL-USER>
; No values
CL-USER> (with-open-file (stream "parser-test.txt")
(loop for line = (read-line stream nil)
while line
do (print (integer? (create-parser-context line)))))
NIL
123
NIL
34
32
NIL
you can read files, by character, by line ..., take a look at hypersec function read; finally I would recommend this nice post with a big lesson of lisp Lisp: It's Not About Macros, It's About Read
I have two closures that are complement of each other. I want to define one in terms of the other one. For example, lets say that we have the function more-than defined as follows
(defun more-than (v) #'(lambda (x) (> x v)))
CL-USER> (funcall (more-than 5) 7)
T
CL-USER> (funcall (more-than 5) 3)
NIL
and we want to define its complement, less-than-or-equal using the above closure. This seems to be not as easy as the above closure, as my attempts have not worked so far. Can somebody point out at a possible solution or tell me if this is common pattern at all (i.e., instead of defining the second closure independent of the first one).
Here are two of my tries that didn't work
;; compile time error
(defun less-than-or-equal (v)
#'(lambda (x) #'(not (more-than v))))
;; returns nil for every comparison
(defun less-than-or-equal (v)
#'(lambda (x) (not (more-than v))))
As I mentioned in the comments, you can use COMPLEMENT to make the complement of a function:
(defun less-than-or-equal (v)
(complement (more-than v)))
In your attempts you're using NOT to negate the function returned by MORE-THAN, rather than calling the function and negating the result. X is not used at all. To fix it, you would need to do
(defun less-than-or-equal (v)
;; The #' is not necessary here
(lambda (x) (not (funcall (more-than v) x))))
But using COMPLEMENT is better.
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))
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.
Can anybody explain an example in Paul Graham's ANSI Common Lisp page 110?
The example try to explain the use &rest and lambda to create functional programming facilities. One of them is a function to compose functional arguments. I cannot find anything explaining how it worked. The code is as follows:
(defun compose (&rest fns)
(destructuring-bind (fn1 . rest) (reverse fns)
#'(lambda (&rest args)
(reduce #'(lambda (v f) (funcall f v))
rest
:initial-value (apply fn1 args)))))
The usage is:
(mapcar (compose #'list #'round #'sqrt)
'(4 9 16 25))
The output is:
((2) (3) (4) (5))
Line 2 and 6 look especially like magic to me.
The compose function returns a closure that calls each of the functions from last to first, passing on the result of each function call to the next.
The closure resulting from calling (compose #'list #'round #'sqrt) first calculates the square root of its argument, rounds the result to the nearest integer, then creates a list of the result. Calling the closure with say 3 as argument is equivalent to evaluating (list (round (sqrt 3))).
The destructuring-bind evaluates the (reverse fns) expression to get the arguments of compose in reverse order, and binds its first item of the resulting list to the fn1 local variable and the rest of the resulting list to the rest local variable. Hence fn1 holds the last item of fns, #'sqrt.
The reduce calls each the fns functions with the accumulated result. The :initial-value (apply fn1 args) provides the initial value to the reduce function and supports calling the closure with multiple arguments. Without the requirement of multiple arguments, compose can be simplified to:
(defun compose (&rest fns)
#'(lambda (arg)
(reduce #'(lambda (v f) (funcall f v))
(reverse fns)
:initial-value arg)))
destructuring-bind combines destructors with binding. A destructor is a function that lets you access a part of a data structure. car and cdr are simple destructors to extract the head and tail of a list. getf is a general destructor framework. Binding is most commonly performed by let. In this example, fns is (#'list #'round #'sqrt) (the arguments to compose), so (reverse fns) is (#'sqrt #'round #'list). Then
(destructuring-bind (fn1 . rest) '(#'sqrt #'round #'list)
...)
is equivalent to
(let ((tmp '(#'sqrt #'round #'list)))
(let ((fn1 (car tmp))
(rest (cdr tmp)))
...))
except that it doesn't bind tmp, of course. The idea of destructuring-bind is that it's a pattern matching construct: its first argument is a pattern that the data must match, and symbols in the pattern are bound to the corresponding pieces of the data.
So now fn1 is #'sqrt and rest is (#'round #'list). The compose function returns a function: (lambda (&rest args) ...). Now consider what happens when you apply that function to some argument such as 4. The lambda can be applied, yielding
(reduce #'(lambda (v f) (funcall f v))
'(#'round #'list)
:initial-value (apply #'sqrt 4)))
The apply function applies fn1 to the argument; since this argument is not a list, this is just (#'sqrt 4) which is 2. In other words, we have
(reduce #'(lambda (v f) (funcall f v))
'(#'round #'list)
:initial-value 2)
Now the reduce function does its job, which is to apply #'(lambda (v f) (funcall f v)) successively to the #'round and to #'list, starting with 2. This is equivalent to
(funcall #'list (funcall #'round 2))
→ (#'list (#'round 2))
→ '(2)
Okay, here goes:
It takes the functions given, reverses it (in your example, it becomes (#'sqrt #'round #'list)), then sticks the first item into fn1, and the rest into rest. We have: fn1 = #'sqrt, and rest = (#'round #'list).
Then it performs a fold, using (apply sqrt args) (where args are the values given to the resulting lambda) as the initial value, and with each iteration grabbing the next function from rest to call.
For the first iteration you end up with (round (apply sqrt args)), and the second iteration you end up with (list (round (apply sqrt args))).
Interestingly, only the initial function (sqrt in your case) is allowed to take multiple arguments. The rest of the functions are called with single arguments only, even if any particular function in the chain does a multiple-value return.
This example stumped me for a day. I could finally understand it by renaming some of the arguments and commenting each line before it made sense. Below is what helped me explain it to myself.
In the book example using the call:
(mapcar (compose #'list #'round #'sqrt) '(4 9 16 25))
The parameter functions becomes (#'LIST #'ROUND #'SQRT)
(defun compose (&rest functions)
(destructuring-bind (fx . fxs) (reverse functions)
;; fx becomes #'SQRT
;; fxs becomes '(#'ROUND #'LIST)
#'(lambda (&rest args) ; This is the function returned as result.
;; The args parameter will be (4) on the mapcar's first
;; iteration on the (4 9 16 25) list passed in the call:
;; (mapcar #'(compose #'List #'round #'sqrt) '(4 9 16 25)) => ((2) (3) (4) (5))
;; or e.g. the (4) in (funcall (compose #'list #'sqrt '(4)) => (2.0)
;; Note that args is not ((#'ROUND #'LIST)).
(reduce #'(lambda (x y) (funcall y x))
;; fxs is (#'ROUND #'LIST) - captuted as closure since it is now
;; locally unbound.
fxs
;; Initial value is: (apply #'SQRT '(4) => 2.0.
;; In Paul Graham's example, the mapcar passes
;; each square number individually.
;; The reverse order of parameters in the second lambda
;; first invokes: (ROUND 2.0) => 2
;; and then invokes: (LIST 2) => (2)
:initial-value (apply fx args)))))