I would like to write a macro to create shorthand syntax for hiding more verbose lambda expressions, but I'm struggling to understand how to write macros (which I realize is an argument against using them).
Given this example:
(define alist-example
'((x 1 2 3) (y 4 5 6) (z 7 8 9)))
(define ($ alist name)
(cdr (assoc name alist)))
((lambda (a) (map (lambda (x y z) (+ x y z)) ($ a 'x) ($ a 'y) ($ a 'z))) alist-example)
((lambda (a) (map (lambda (y) (/ y (apply max ($ a 'y)))) ($ a 'y))) alist-example)
I would like to write a macro, with-alist, that would allow me to write the last two expressions similar to this:
(with-alist alist-example (+ x y z))
(with-alist alist-example (/ y (apply max y)))
Any advice or suggestions?
Here is a syntax-rules solution based on the feedback that I received in the other answer and comments:
(define ($ alist name)
(cdr (assoc name alist)))
(define-syntax with-alist
(syntax-rules ()
[(_ alist names expr)
(let ([alist-local alist])
(apply map (lambda names expr)
(map (lambda (name) ($ alist-local name)) (quote names))))]))
Here is some example usage:
> (define alist-example
'((x 1 2 3) (y 4 5 6) (z 7 8 9)))
> (with-alist alist-example (x) (+ x 2))
(3 4 5)
> (with-alist alist-example (x y) (+ x y))
(5 7 9)
> (with-alist alist-example (x y z) (+ x y z))
(12 15 18)
This answer stops short of solving the more complicated example, (with-alist alist-example (/ y (apply max y))), in my question, but I think this is a reasonable approach for my purposes:
> (with-alist alist-example (y) (/ y (apply max ($ alist-example 'y))))
(2/3 5/6 1)
EDIT: After some additional tinkering, I arrived at a slightly different solution that I think will provide more flexibility.
My new macro, npl, expands shorthand expressions into a list of names and procedures.
(define-syntax npl
(syntax-rules ()
[(_ (names expr) ...)
(list
(list (quote names) ...)
(list (lambda names expr) ...))]))
The output of this macro is passed to a regular procedure, with-list-map, that contains most the core functionality in the with-alist macro above.
(define (with-alist-map alist names-proc-list)
(let ([names-list (car names-proc-list)]
[proc-list (cadr names-proc-list)])
(map (lambda (names proc)
(apply map proc
(map (lambda (name) ($ alist name)) names)))
names-list proc-list)))
The 3 examples of with-alist usage above can be captured in a single call to with-alist-map.
> (with-alist-map alist-example
(npl ((x) (+ x 2))
((x y) (+ x y))
((x y z) (+ x y z))))
((3 4 5) (5 7 9) (12 15 18))
The immediate problem I see is that there is no way to tell which bindings to pick. Eg. is apply one of the elements in the alist or is it a global variable? That depends. I suggest you do:
(with-alist ((x y z) '((x 1 2 3) (y 4 5 6) (z 7 8 9)))
(+ x y z))
(let ((z 10))
(with-alist ((x y) alist-example)
(+ x y z)))
And that it should translate to:
(let ((tmp '((x 1 2 3) (y 4 5 6) (z 7 8 9))))
(apply map (lambda (x y z) (+ x y z))
(map (lambda (name) ($ tmp name)) '(x y z))))
(let ((z 10))
(let ((tmp alist-example))
(apply map (lambda (x y) (+ x y z))
(map (lambda (name) ($ tmp name)) '(x y)))))
This is then straight forward to do with syntax-rules. Eg. make a pattern and write the replacement. Good luck.
Related
(define (avg . l)
(/ (apply + l) (length l)))
(define (delist ls)
(apply values ls))
(avg (delist '(1 2 3))) ;;error
(avg 1 2 3) ;; return 2
without call-with-values, can I bind the value returned by values to each parameter in other ways?
can I bind the value returned by values to each parameter in other ways?
Here are most of the ways I know of to bind variables to returned values in Racket:
#lang racket/base
(define (list->values lst) (apply values lst))
(define-values (a b c) (list->values '(1 2 3)))
(displayln (+ a b c))
(let-values ([(d e f) (list->values '(4 5 6))])
(displayln (+ d e f)))
(require racket/match)
(match/values (list->values '(7 8 9))
([x y z] (displayln (+ x y z))))
(require srfi/8)
(receive (i j k) (list->values '(10 11 12)) (displayln (+ i j k)))
(displayln (call-with-values (lambda () (list->values '(13 14 15))) +))
While reading up on some lisp history here From LISP 1 to LISP 1.5, I came across this function:
(define (testr x p f u)
(if (p x)
(f x)
(if (atom? x)
(u)
(testr (cdr x)
p
f
(lambda ()
(testr (car x) p f u))))))
According to McCarthy, "The difficulty was that when an inner recursion occurred, the value of car[x] wanted was the outer value, but the inner value was actually used. In modern terminology, lexical scoping was wanted, and dynamic scoping was obtained."
I can't quite figure out what "outer value" and "inner value" he is referring to nor can I see how this function misbehaves when evaluated with dynamical scoping. I could understand if the lambda some how shadowed 'x' but it is a function of zero arguments.
(It was quite difficult to actually find this function as it seems to be missing from the webpage itself. It was only after exploring the images.tex file here:http://www-formal.stanford.edu/jmc/history/lisp/images.tex that I found it).
Let's do it in Lisp, here Common Lisp. In Common Lisp it's easy to switch between dynamic and lexical binding.
Lexical Scope
This example uses lexical binding.
(defun testr (x p f u)
(if (funcall p x)
(funcall f x)
(if (atom x)
(funcall u)
(testr (cdr x)
p
f
(lambda ()
(testr (car x) p f u))))))
What should the function do? It should find the right most element in nested lists for which P is true.
CL-USER 36 > (testr '(1 (2 3) 3 (7 6 6))
(lambda (y) (and (numberp y) (oddp y)))
#'identity
nil)
7
CL-USER 37 > (testr '(1 (2 3) 3 (6 6 6))
(lambda (y) (and (numberp y) (oddp y)))
#'identity
nil)
3
As you see, the returned values are as expected.
Dynamic Scope
If we use dynamic binding, then this happens:
(defun testr (x p f u)
(declare (special x p f u)) ; use dynamic binding
(if (funcall p x)
(funcall f x)
(if (atom x)
(funcall u)
(testr (cdr x)
p
f
(lambda ()
(testr (car x) p f u))))))
CL-USER 38 > (testr '(1 (2 3) 3 (6 6 6))
(lambda (y) (and (numberp y) (oddp y)))
#'identity
nil)
Stack overflow (stack size 15998).
If we define ecar like car, but to signal an error when the item is not a cons:
(defun ecar (item)
(if (consp item)
(car item)
(error "Item ~a not a cons" item)))
(defun testr (x p f u)
(declare (special x p f u))
(if (funcall p x)
(funcall f x)
(if (atom x)
(funcall u)
(testr (cdr x)
p
f
(lambda ()
(testr (ecar x) p f u))))))
CL-USER 52 > (testr '(1 2)
(lambda (y)
(and (numberp y) (oddp y)))
#'identity
nil)
Error: Item NIL not a cons
At the end of the list, x is nil and that's not a cons, so (ecar x) signals an error.
Problem
(defun testr (x p f u)
(declare (special x p f u)) ; use dynamic binding
(if (funcall p x)
(funcall f x)
(if (atom x)
(funcall u) ; INNER: here the lambda function is called
; with dynamic binding, the value of X
; is the current binding of X from
; the current call.
: at the end of a list, X would be NIL.
; Inside the lambda function then X would be NIL, too.
; (car x) -> returns NIL
; then we are in an endless recursion
; OUTER: with lexical binding, the value
; of X would be the value of some
; binding where the function was
; defined and called earlier.
(testr (cdr x)
p
f
(lambda () ; our lambda function
(testr (car x) ; the reference to X
p f u))))))
Simple tracing
Let's see how it visits the elements:
Lexical:
CL-USER 42 > (testr '(1 (2 3) 4 (6 8 10))
(lambda (y)
(print (list :test y))
(and (numberp y) (oddp y)))
#'identity
nil)
(:TEST (1 (2 3) 4 (6 8 10)))
(:TEST ((2 3) 4 (6 8 10)))
(:TEST (4 (6 8 10)))
(:TEST ((6 8 10)))
(:TEST NIL) ; it has reached the end of the top list
(:TEST (6 8 10)) ; it recurses down the rightmost sublist
(:TEST (8 10))
(:TEST (10))
(:TEST NIL) ; end of the rightmost sublist
(:TEST 10) ; checks the elements of the rightmost sublist
(:TEST 8)
(:TEST 6)
(:TEST 4) ; back up, next element of the top list
(:TEST (2 3)) ; next sublist of the top list
(:TEST (3))
(:TEST NIL) ; end of that sublist
(:TEST 3) ; checks right element, found
3
Dynamic:
CL-USER 40 > (testr '(1 (2 3) 4 (6 8 10))
(lambda (y)
(print (list :test y))
(and (numberp y) (oddp y)))
#'identity
nil)
(:TEST (1 (2 3) 4 (6 8 10)))
(:TEST ((2 3) 4 (6 8 10)))
(:TEST (4 (6 8 10)))
(:TEST ((6 8 10)))
(:TEST NIL) ; it reaches the end of the top list
(:TEST NIL) ; it goes into the endless recursion
(:TEST NIL)
(:TEST NIL)
(:TEST NIL)
(:TEST NIL)
...
In Common Lisp, I can get a function to pass around with the #' syntax, like this:
(let ((x #'+))
(funcall x 1 2))
But suppose I want to set a function so I don't have to use funcall for it. Does Common Lisp have a local function name table, or just the global one that is assigned to with defun?
Is there a way to assign to a function symbol other than defun? Or more generally: is there a way I can do something similar to this nonworking example:
(setf #'x #'+)
(x 1 2)
You can define a local function using
flet and labels:
(flet ((f (x) (1+ (* 2 x))))
(f 7))
==> 15
You can also set function definition of a symbol using fdefinition:
(setf (fdefinition 'f) #'+)
(f 1 2 3)
==> 6
Note that let binds the
value cell of the symbol while flet bind the function cell.
When the symbol appears in the "function" position, the "function"
cell is used, while when it appears in the "value" position, the "value"
cell is used:
(setf (symbol-function 'x) #'car)
(setf (symbol-value 'x) #'cdr)
(x '(1 . 2))
==> 1
(funcall x '(1 . 2))
==> 2
Similarly,
(flet ((x (o) (car o)))
(let ((x #'cdr))
(cons (x '(1 . 2))
(funcall x '(1 . 2)))))
==> (1 . 2)
This is the difference between Lisp-1 and Lisp-2.
Finally, note that CLISP is just one implementation of the language ANSI Common Lisp.
One option for getting this kind of behavior is to write a macro to do it.
(defmacro flet* (assignments &body body)
(let ((assignments (mapcar
(lambda (assn)
(list (first assn) '(&rest args)
(list 'apply (second assn) 'args)))
assignments)))
`(flet ,assignments ,#body)))
This macro translates flet* into flet + apply like this:
(flet* ((x #'+)
(y #'*))
(pprint (x 1 2))
(pprint (y 3 4))
(pprint (x (y 2 3) 4)))
Becomes:
(flet ((x (&rest args) (apply #'+ args))
(y (&rest args) (apply #'* args)))
(pprint (x 1 2))
(pprint (y 3 4))
(pprint (x (y 2 3) 4)))
I wish to overload the + operator to work on common lisp vectors -- just as it would for vectors in linear algebra. Is it possible to overload with the + operator?
Here is my intended definition:
(defmethod + ((v1 vector) (v2 vector))
Thanks in advance for all the help!
If I were to do this, I would start by doing it in a separate package. I would then write a general function that uses binary operators:
(defun + (&rest addends)
(reduce #'binary+ (cdr addends) :initial-value (car addends)))
(defgeneric binary+ (addend1 addend2))
Then you can define methods on the generic function binary+ that would allow you to add two vectors, a vector and a scalar, ...
Something that would be a suitable wrapper-generating macro:
(defmacro define-operator (op &key (binary-signifier :binary) (package *package*)
"Defines a generic operator OP, being essentially a reduce operation using
a generic function whose name is a concatenation of BINARY-SIGNIFIER and OP."
(let ((op op)
(binary (intern (concatenate 'string
(string binary-signifier)
(string op))
package)))
`(progn
(defun ,op (&rest args)
(reduce (function ,binary) (cdr args) :initial-value (car args)))
(defgeneric ,binary (arg1 arg2)))))
Then you can define methods, as per Joshua Taylor's answer:
(defmethod binary+ ((x number) (y number))
(cl:+ x y))
(defmethod binary+ ((x vector) (y vector))
(map 'vector 'cl:+ x y))
(defmethod binary+ ((x list) (y list))
(map 'list 'cl:+ x y))
This is an extension of Vatine's answer, but with some more detail to make the implementaiton clearer:
(defpackage #:generic-arithmetic
(:use "COMMON-LISP")
(:shadow "+"))
(in-package #:generic-arithmetic)
(defun + (&rest addends)
(reduce 'binary+ (cdr addends) :initial-value (car addends)))
(defgeneric binary+ (addend1 addend2))
(defmethod binary+ ((x number) (y number))
(cl:+ x y))
(defmethod binary+ ((x vector) (y vector))
(map 'vector 'cl:+ x y))
(defmethod binary+ ((x list) (y list))
(map 'list 'cl:+ x y))
(+ 1 1)
;=> 2
(+ #(1 2) #(0 -1))
;=> #(1 1)
(+ '(1 3) '(3 1))
;=> (4 4)
It's probably not a good idea to define generic function +, because, well, this symbol is locked. CLOS is different from object systems in other languages, such as C++, so term `overload' is probably not quite correct.
Actually, you do not need a special function to sum vectors, use map:
CL-USER> (let ((v0 #(1 2 3))
(v1 #(4 5 6)))
(map 'vector #'+ v0 v1))
#(5 7 9)
It's possible to redefine + if you shadow it first:
? (shadow '+)
? (defgeneric + (a &rest b))
? (defmethod + ((a number) &rest b) (apply 'cl:+ a b))
? (+ 1 2)
3
? (+ 2 3 4)
9
? (defmethod + ((a string) &rest b) (apply #'cl:concatenate 'string a b))
? (+ "Hello" "World")
"HelloWorld"
? (+ "Hello" " cruel " "World")
"Hello cruel World"
? (defmethod + ((a vector) &rest b) (apply #'map 'vector 'cl:+ a b))
? (let ((v0 #(1 2 3)) (v1 #(4 5 6))) (+ v0 v1))
#(5 7 9)
I have a macro called compare-and-swap!:
(define-macro (compare-and-swap! l x y)
`(if (> (vector-ref ,l ,x) (vector-ref ,l ,y))
(vector-swap! ,l ,x ,y)))
It works, I'm testing it like this:
(define v (list->vector '(5 4 3 2 1)))
(print v)
(compare-and-swap! v 1 2)
(print v)
I have a function that returns a list of pairs that I can call compare-and-swap! on serially to sort the whole list:
(batcher 8) → ((0 1) (2 3) (0 2) (1 3) (1 2) (4 5) (6 7) (4 6) (5 7) (5 6) (0 4) (2 6) (2 4) (1 5) (3 7) (3 5) (1 2) (3 4) (5 6))
Now I wish to create a macro that generates a lambda that sorts an N element list by calling batcher and doing the compare-and-swap! for each pair.
For example,
(generate-sorter 8)
→
(lambda (l) (begin (compare-and-swap! l 0 1) (compare-and-swap! l 2 3) ...))
→
(lambda (l) (begin (if (> (vector-ref l 0) (vector-ref l 1)) (vector-swap! 0 1)) (if (> (vector-ref l 2) (vector-ref l 3)) (vector-swap! 2 3))) ... )
I made a function that generates the necessary code:
(define generate-sorter (lambda (len)
(list 'lambda '( li ) 'begin (map (lambda (pair) (list 'compare-and-swap! 'li (first pair) (second pair))) (batcher len)))
))
But I don't now how to make it into a macro.
You don't need a macro for this and, in particular, for the 'generate' part. I suspect that you were thinking macro because the result of generate-sorter can vary from call to call and you hoped to encode the result through macro expansion. An alternative is to capture the result in the lexical environment as such:
(define-syntax compare-and-swap!
(syntax-rules ()
((_ l x y)
(when (> (vector-ref l x) (vector-ref l y))
(vector-swap! l x y)))))
(define (generate-sorter n)
(let ((sorters (generate-sorter n)))
(lambda (l)
(for-each (lambda (sorter)
(compare-and-swap! l (car sorter) (card sorter)))
sorters))))
(define sorter-8 (generate-sorter 8))
(sorter-8 <l-thingy>)
-> <sorted-l-thingy>