I'm learning about the macro system in Scheme and I thought implementing curried functions would be a good start. This is what I cooked up:
(define-syntax function
(syntax-rules ()
((_ () body ...) (lambda () body ...))
((_ (param) body ...) (lambda (param) body ...))
((_ (param_1 param_2 params ...) body ...) (lambda (param_1 . rest)
(let ((k (function (param_2 params ...) body ...)))
(if (null? rest) k (apply k rest)))))
((_ name params body ...) (define name (function params body ...)))))
This code works as expected to. For example I can define an add function as follows:
(function add (x y) (+ x y))
Then I can call it normally:
(add 2 3) ; => 5
In addition I can easily partially apply it:
(map (add 10) '(2 3 5 7)) ; => (12 13 15 17)
Now I'm contemplating to allow functions with rest parameters to be curried. So I added a new syntax rule:
((_ (param . params) body ...) (lambda (param . params) body ...))
Unfortunately when I try to create a function using this rule it gives me an error:
(function add (x . y) (apply + `(,x ,#y)))
This is the error message:
Error: invalid syntax in macro form: (x . y)
Call history:
<eval> (##sys#= len7 0)
<eval> (loop11 (##sys#cdr l6) (##sys#+ len7 -1))
<eval> (##sys#cdr l6)
<eval> (##sys#+ len7 -1)
<eval> (##sys#= len7 0)
<eval> (loop11 (##sys#cdr l6) (##sys#+ len7 -1))
<eval> (##sys#cdr l6)
<eval> (##sys#+ len7 -1)
<eval> (##sys#= len7 0)
<eval> (##sys#eq? l6 (quote ()))
<eval> (##sys#car tail15)
<eval> (##sys#cdr tail15)
<eval> (##sys#cons (rename14 (##core#syntax lambda)) (##sys#cons param body))
<eval> (rename14 (##core#syntax lambda))
<eval> (##sys#cons param body)
<syntax> (##core#lambda add (x . y) (apply + (quasiquote ((unquote x) (unquote-splicing y))))) <-
What am I doing wrong?
[The comment is correct; this answer is not currying, it is partial evaluation.]
Just so you know, you don't need to use define-syntax to support currying. Generally using syntax when you don't need to is frowned upon because 1) syntax introduces different evaluation rules and 2) syntax can't be used as a value.
Here are two implementations, one for (left) curry and one for right curry:
(define (curry func . curry-args)
(lambda args
(apply func (append curry-args args))))
(define (rcurry func . curry-args)
(lambda args
(apply func (append args curry-args))))
Use this as for example:
> (define add-5 (curry + 5))
> (add-5 5)
10
You don't say what version of Scheme you're using. It appears that it doesn't support 'dot' patterns in macros.
In Racket, it looks like your code works:
#lang racket
(define-syntax function
(syntax-rules ()
((_ () body ...) (lambda () body ...))
((_ (param) body ...) (lambda (param) body ...))
((_ (param_1 param_2 params ...) body ...) (lambda (param_1 . rest)
(let ((k (function (param_2 params ...) body ...)))
(if (null? rest) k (apply k rest)))))
((_ (param . params) body ...) (lambda (param . params) body ...))
((_ name params body ...) (define name (function params body ...)))))
(function add (x . y) (apply + `(,x ,#y)))
(add 2 3)
running this produces the answer
5
.
BTW, I think I would have written this as two macros; the dual-purposing of the name 'function' is a bit sketchy... :)
Related
I'm trying to write a macro to generate Church encodings I have this so far
#lang racket
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
(let ((_ctrs (map car '((ctr) ...)))
(_args '((args ...) ...)))
(map
(lambda (i)
(let ((_ctr (list-ref _ctrs i))
(_args (list-ref _args i)))
`(define (,_ctr ,#_args) (lambda (,#_ctrs) (,_ctr ,#_args)))))
(range 0 (length _ctrs))))
]
))
(pretty-print (data option (some x) (none))
Which outputs
(data option (some x) (none))
=> ((define (some x) (lambda (some none) (some x)))
(define (none) (lambda (some none) (none))))
The output is good, but the defines are not being executed.
Now I want to execute these defines so that the functions are defined at top level
I tried this
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
`(let ((_ctrs (map car '((ctr) ...)))
(_args '((args ...) ...)))
,#(map
(lambda (i)
(let ((_ctr (list-ref _ctrs i))
(_args (list-ref _args i)))
(define (,_ctr ,#_args) (lambda (,#_ctrs) (,_ctr ,#_args)))))
(range 0 (length _ctrs))))
]
))
But I get this error
(data option (some x) (none))
Error: struct:exn:fail:syntax
begin (possibly implicit): the last form is not an expression
at: (define ((unquote _ctr) (unquote-splicing _args)) (lambda ((unquote-splicing _ctrs)) ((unquote _ctr) (unquote-splicing _args))))
in: (begin (define ((unquote _ctr) (unquote-splicing _args)) (lambda ((unquote-splicing _ctrs)) ((unquote _ctr) (unquote-splicing _args)))))
I tried (expand #'(data option (some x) (none))) to debug but got the same error. I'm new to Racket, any advice on the macro debugging flow is welcome!!
---- Update
I have this macro now, it seems closer to what I need
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
#'((define (ctr) (lambda (ctr ...) (ctr args ...))) ...)
]
))
But still if I remove the #' I get
define: not allowed in an expression context
in: (define (some) (lambda (some none) (some x)))
Okay I got it, I need a (begin here how I did it
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
(begin
(define (ctr args ...) (lambda (ctr ...) (ctr args ...)))
...
)
]
))
(data option (some x) (none))
((some 1)
(lambda (x) (format "is some ~a" x))
(lambda () "is none")) ;; "is some 1"
I am currently porting Alex Shinn's canonical implementation of match for Scheme, which is used by almost all Scheme implementations, to another Lisp.
I've run into a total wall with match-letrec. In the simplified version of his implementation, it's defined as follows:
(define-syntax match-let
(syntax-rules ()
((_ ((pat expr)) . body)
(match expr (pat . body)))
((_ ((pat expr) ...) . body)
(match (list expr ...) ((pat ...) . body)))
((_ loop . rest)
(match-named-let loop () . rest))
))
(define-syntax match-letrec
(syntax-rules ()
((_ vars . body) (match-letrec-helper () vars . body))))
(define-syntax match-letrec-helper
(syntax-rules ()
((_ ((pat expr var) ...) () . body)
(letrec ((var expr) ...)
(match-let ((pat var) ...)
. body)))
((_ (v ...) ((pat expr) . rest) . body)
(match-letrec-helper (v ... (pat expr tmp)) rest . body))
))
Here's an example of how it looks when in use (Guile 1.8):
(match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b))
=> (2 1 1 2)
I'm having great difficulty understanding how this actually works. When I expand this by hand as far as match, I get the following code (with automatic symbols indicated by #{g...}):
(letrec ((#{g1} (list 1 (lambda () (list a x))))
(#{g2} (list 2 (lambda () (list x a)))))
(match (list #{g1} #{g2}) (((x y) (a b)) (append (y) (b))))
The automatic symbols are generated by the tmp substitution in the second rule of match-letrec-helper. This expansion means that the lambda expressions are evaluated before x and a are bound, and therefore cannot capture them.
Can someone please explain how this syntax is supposed to be correctly expanded? What have I missed?
Your example
(match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b))
=> (2 1 1 2)
is missing a close bracket.
After fixing that here's what happens:
> (match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b)))
. match: syntax error in pattern in: ((x y) (a b))
Even match-let is not working
> (match-let (((x y) (list 1 2)))
x)
. match: syntax error in pattern in: (x y)
here's how to fix it:
(define-syntax match-let
(syntax-rules (list)
((_ ((pat expr)) . body)
(match expr (pat . body)))
((_ ((pat expr) ...) . body)
(match (list expr ...) ((pat ...) . body)))
((_ loop . rest)
(match-named-let loop () . rest))
))
now you can do this:
> (match-let (((list x y) (list 1 2)))
(list x y))
'(1 2)
letrec is still not working
> (match-letrec (((list x y) (list 1 (lambda () (list a x))))
((list a b) (list 2 (lambda () (list x a)))))
(append (y) (b)))
. match: syntax error in pattern in: ((list x y) (list a b))
but this should get you a step closer, feel free to ask a new question with working code example once you understand these changes.
Say I have a macro like this:
(define-syntax (choose stx)
(define data (syntax->datum stx))
(define args (cadr data))
(define body (cddr data))
(define output
`(apply (case (car ,args)
,(map (lambda (choice)
`((,(car choice)) ,(cadr choice)))
body)
(else (displayln "error")))
(cdr ,args)))
(println output)
#'(void))
If I use this on something like this (there could be more options):
(choose args
("run" runsomething)
("del" delsomethingelse))
It transforms it to
(apply
(case (car args)
((("run") runsomething)
(("del") delsomethingelse))
(else (displayln "error")))
(cdr args))
Which is not valid code, because the map gave it extra parentheses. Instead I want it to give me this:
(apply
(case (car args)
(("run") runsomething)
(("del") delsomethingelse)
(else (displayln "error")))
(cdr args))
How could I do something like this?
Use unquote-splicing (aka ,#) to get rid of the list surrounding map.
Example:
(define xs '(a b c))
`(1 2 ,xs 3 4) ; => '(1 2 (a b c) 3 4)
`(1 2 ,#xs 3 4) ; => '(1 2 a b c 3 4)
However I notice that you use syntax->datum on the input stx
of the syntax transformer. That removes lexical information, which
could end up causing problems. It recommend using either syntax-case
or syntax-parse, which use pattern matching to pick out the elements
of the input syntax and templates to generate the output.
(define-syntax (choose stx)
(syntax-case stx ()
[(_choose args
(datum fun-expr)
...)
#'(apply (case (car args)
[(datum) fun-expr]
...)
(cdr args))]))
(define (run-it . xs) (list 'ran-it xs))
(define (del-it . xs) (list 'delt-it xs))
(choose (list "run" 1 2 3)
("run" run-it)
("del" del-it))
Output: '(ran-it (1 2 3))
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))
In other words, is it possible to locally define a function in a way similar to how flet or labels does it? My final goal is to have a macro similar to labels which instead of regular functions uses instances of funcallable-standard-class and not having to use funcall. A use-case might look like the one below:
(funcallable-let ((foo func-class :initargs ...))
(foo ...))
symbol-macrolet seems to only expand when not in the head position. If I try (setf (symbol-function 'foo) (make-instance 'some-funcallable-class)) this sets it globally for this symbol an not for the scope of the enclosing let.
Here's what I could get so far (but it doesn't work because macrolet wouldn't expand in this scenario...)
(defclass func ()
((state :initarg :state :accessor state-of))
(:metaclass sb-mop:funcallable-standard-class))
(defmethod initialize-instance :after ((this func) &rest initargs)
(declare (ignore initargs))
(sb-mop:set-funcallable-instance-function
this (lambda ()
(format t "~&I am: ~s, my state is: ~s" this (state-of this)))))
(defmacro funcallable-let (bindings &body body)
(loop :for binding :in bindings
:for name := (car binding)
:for class := (cadr binding)
:for init-args := (cddr binding)
:collect `(,name (make-instance ',class ,.init-args)) :into classes
:collect `(,name (&rest args) (list 'apply '',name args)) :into macrolets
:collect name :into ignorables
:finally
(return
`(let ,classes
(declare (ignorable ,#ignorables))
(macrolet ,macrolets
,#body)))))
(defun test-funcallable-let ()
(funcallable-let ((f func :state :f-state)
(g func :state :g-state))
(f) (funcall 'g)))
This is somewhat modified Lars' Brinkoff macro:
(defmacro funcallable-let (bindings &body body)
(loop
:for binding :in bindings
:for symbol := (gensym)
:for name := (car binding)
:for class := (cadr binding)
:for init-args := (cddr binding)
:collect `(,symbol (make-instance ',class ,.init-args)) :into lets
:collect `(,name (&rest args) (apply ',symbol args)) :into flets
:collect symbol :into ignorables
:finally
(return
`(let ,lets
(declare (ignorable ,#ignorables))
(flet ,flets ,#body)))))
Which wouldn't work either.
So, we want the value of f to be the funcallable object, so that things like (setf (state-of f) new-state) work, but also a macro definition for f, so that (f 1 2 3) expands to (funcall f 1 2 3). Let's write some direct code first. First, your func definition, but with a slightly different funcallable instance function, so that we can pass some arguments in and see what they are:
(defclass func ()
((state :initarg :state :accessor state-of))
(:metaclass sb-mop:funcallable-standard-class))
(defmethod initialize-instance :after ((this func) &rest initargs)
(declare (ignore initargs))
(sb-mop:set-funcallable-instance-function
this (lambda (&rest args)
(format t "~&I am: ~s, my state is: ~s, my args were ~s" this (state-of this) args))))
Then, we can write the code that we'd want the funcallable-let to expand into. As the output shows, f in a head position ends up being a call to the funcallable instance, but f in a non head position is a variable that has the funcallable instance as a value, so you can, e.g., (setf (state-of f) new-state):
(let ((f (make-instance 'func :state 34)))
(macrolet ((f (&rest args)
`(funcall f ,#args)))
(f 1 2 3)
(setf (state-of f) 89)
(f 4 5 6)))
; I am: #<FUNC {1002A0B329}>, my state is: 34, my args were (1 2 3)
; I am: #<FUNC {1002A0B329}>, my state is: 89, my args were (4 5 6)
That seems good. Now we just need to macroify it:
(defmacro funcallable-let (bindings &body body)
`(let (,#(loop :for (name . initargs) :in bindings
:collect `(,name (make-instance 'func ,#initargs))))
(macrolet (,#(loop :for (name . initargs) :in bindings
:collect `(,name (&rest args)
`(funcall ,',name ,#args))))
,#body)))
The macroexpansion looks right:
CL-USER> (pprint (macroexpand '(funcallable-let ((f :state 34))
(f 1 2 3))))
(LET ((F (MAKE-INSTANCE 'FUNC :STATE 34)))
(MACROLET ((F (&REST ARGS)
`(FUNCALL F ,#ARGS)))
(F 1 2 3)))
And the behavior seems right (you can call with (f ...) or with (funcall f ...), and you can (setf (state-of f) ...):
CL-USER> (funcallable-let ((f :state 34))
(f 1 2 3)
(setf (state-of f) 89)
(f 4 5 6)
(setf (state-of f) 62)
(funcall f 7 8 9))
I am: #<FUNC {1002BEC389}>, my state is: 34, my args were (1 2 3)
I am: #<FUNC {1002BEC389}>, my state is: 89, my args were (4 5 6)
I am: #<FUNC {1002BEC389}>, my state is: 62, my args were (7 8 9)
NIL
I'm not sure what you are trying to do, but maybe this?
(defmacro funcallable-let (bindings &body body)
(let ((gensyms (loop repeat (length bindings) collect (gensym))))
`(let ,(loop for (name value) in bindings and g in gensyms
collect `(,g ,value))
(flet ,(loop for (name value) in bindings and g in gensyms
collect `(,name (&rest args) (apply ,g args)))
,#body))))
Sample usage:
(funcallable-let ((foo (make-instance 'some-funcallable-class :initargs ...)))
(foo ...))
For a similar problem see GENERIC-FLET and GENERIC-LABELS of CLtL2 and why it was removed in ANSI Common Lisp.
http://www.lispworks.com/documentation/HyperSpec/Issues/iss181_w.htm