For some reason the following macro will fail to work with quotation.
(define-syntax expand
(lambda (stx)
(syntax-case stx (break)
[(_ k () (ys ...)) (begin (println (syntax->datum #'(ys ...))) #'(ys ...))]
[(_ k ((break) xs ...) (ys ...)) #'(expand k (xs ...) (ys ... (k (void))))]
[(_ k ((es ...) xs ...) (ys ...)) #'(expand k (xs ...) (ys ... (expand k (es ...) ())))]
[(_ k (a xs ...) (ys ...)) #'(expand k (xs ...) (ys ... a))])))
(define-syntax loop
(syntax-rules ()
[(_ e es ...)
(call/cc (lambda (k)
(let l ()
(expand k (begin e es ...) ())
(l))))]))
(loop (list 1 (break)))
;; => works fine
(loop (quasiquote (1 (unquote (break)))))
;; => break: unbound identifier in module in: break
I am kind of surprised to see why the second case fails.
And the following debug information is printed for both cases.
;; case 1
'(begin (expand k (list 1 (break)) ()))
'(list 1 (k (void)))
;; case 2
'(begin (expand k `(1 ,(break)) ()))
'`(expand k (1 ,(break)) ())
Please note that in the output for case 2 after the quasiquote expansion, the rest (1 ,(break)) is somehow not expanded.
Not sure why this will happen.
Thanks
The problem is that the macro expander doesn't expand macro calls that appear under a quote or quasiquote. For example:
(define-syntax-rule (pipe) "|")
> (quote (pipe))
'(pipe) ; not "|"
> (quasiquote (pipe))
'(pipe) ; not "|"
This can be solved by doing recursion on the syntax object directly at compile time, instead of doing recursion by returning a syntax object with a macro call inside of it.
In general, translate code like this:
(define-syntax expand
(lambda (stx)
(syntax-case stx literals
cases
[pattern #'(.... (expand stuff) ...)]
cases)))
Into code like this:
(begin-for-syntax
(define (expand stx)
(syntax-case stx literals
cases
[pattern #`(.... #,(expand stuff) ...)]
cases)))
In your particular case, you probably want expand to be a 3-argument function, which runs and recurs completely at compile time.
(begin-for-syntax
(define (expand k xs ys)
(with-syntax ([(ys ...) ys])
(syntax-case xs (break)
[() (begin (println (syntax->datum #'(ys ...))) #'(ys ...))]
[((break) xs ...) (expand k #'(xs ...) #'(ys ... (k (void))))]
[((es ...) xs ...) (expand k #'(xs ...) #`(ys ... #,(expand k #'(es ...) #'())))]
[(a xs ...) (expand k #'(xs ...) #'(ys ... a))]))))
Then you can call this compile-time function in the implementation of the loop macro:
(define-syntax loop
(lambda (stx)
(syntax-case stx ()
[(_ e es ...)
#`(call/cc (lambda (k)
(let l ()
#,(expand #'k #'(begin e es ...) #'())
(l))))])))
However, this isn't the best way to do a looping macro.
I'm hoping the compile-time function above helps you understand what's possible with macros. However, for the loop macro it shouldn't be needed. A syntax-parameter provides a much easier way to do this.
(define-syntax-parameter break
(lambda (stx) (raise-syntax-error #f "cannot be used outside of loop" stx)))
(define-syntax loop
(syntax-rules ()
[(_ e es ...)
(call/cc (lambda (k)
(define (break-function) (k (void)))
(syntax-parameterize ([break (make-rename-transformer #'break-function)])
(let l ()
(begin e es ...)
(l)))))]))
In fact, a loop macro like this is one of the examples used in the paper Keeping it Clean with Syntax Parameters section 4, called forever, where it calls the breaking syntax parameter abort.
Related
This question already has answers here:
Is it possible to implement auto-currying to the Lisp-family languages?
(6 answers)
Closed 2 years ago.
I would like to write functions like this:
(define foo (\ (a b c) (+ a (+ b c))))
get it automatically transformed into this:
(define foo (lambda (a) (lambda (b) (lambda (c) (+ a (+ b c))))))
and use it like this (if possible):
(map (foo 1 2) (interval 1 10))
as if I was writing this:
(map ((foo 1) 2) (interval 1 10))
I don't know how to write macros in scheme, but I'd need to write a function that transforms a quoted expression
(f arg1 arg2 argn)
like this:
(define-macro clambda ;curried lambda
(lambda xs
(if (< (length xs) 2)
(if (eq? 1 (length xs))
(lambda () xs)
(lambda (head xs) (tail xs)))
(lambda (head xs) (clambda (tail xs))))))
How can I do this?
Here is my suggestion for your macro:
(define-syntax \
(syntax-rules ()
[(_ "build" (a) body)
(lambda (a . rest)
(if (null? rest)
body
(error "Too many arguments")))]
[(_ "build" (a b ...) body)
(lambda (a . rest)
(define impl (\ "build" (b ...) body))
(if (null? rest)
impl
(apply impl rest)))]
[(_ (a b ...) body)
(\ "build" (a b ...) body)]
[(_ . rest) (error "Wong use of \\")]))
(define test (\ (a b c) (+ a b c)))
(define partial (test 4 5))
(partial 6) ; ==> 15
This does make the resulting code have more overhead since every lambda will apply the next if it gets more arguments. It also will produce an error if you pass too many arguments since you'd otherwise get the unclear "application, not a procedure"
error you may need to implement.
Does call/cc in Scheme the same thing with yield in Python and JavaScript?
I am not clear about generators. In my opinion, yield gives a language the ability to generate iterators without pain. But I am not sure whether I am right.
Does call/cc in Scheme has something related to yield in other languages? If so, are they the same thing, or what is the difference?
Thanks!
call/cc is a much more general language feature than generators. Thus you can make generators with call/cc, but you cannot make call/cc with generators.
If you have a program that computes values and use those values in other places its basically a step machine.. One might think of it as a program that have one function for each step and a continuation for the rest of the steps. Thus:
(+ (* 3 4) (* 5 6))
Can be interpreted as:
((lambda (k)
(k* 3 4 (lambda (v34)
(k* 5 6 (lambda (v56)
(k+ v34 v56 k)))))
halt)
The k-prefix just indicate that it's a CPS-version of the primitives. Thus they call the last argument as a function with the result. Notice also that the order of evaluation, which is not defined in Scheme, is in fact chosen in this rewrite. In this beautiful language call/cc is just this:
(define (kcall/cc kfn k)
(kfn (lambda (value ignored-continuation)
(k value))
k))
So when you do:
(+ (* 3 4) (call/cc (lambda (exit) (* 5 (exit 6)))))
; ==> 18
Under the hood this happens:
((lambda (k)
(k* 3 4 (lambda (v34)
(kcall/cc (lambda (exit k)
(exit 6 (lambda (v6)
(k* 5 v6 k)))
k))))
halt)
By using the substitution we can prove that this actually does exactly as intended. Since the exit function is invoked the original continuation is never called and thus the computation cancelled. In contrast to call/cc giving us this continuation that doesn't seem obvious it's no magic in CPS. Thus much of the magic of call/cc is in the compiler stage.
(define (make-generator procedure)
(define last-return values)
(define last-value #f)
(define (last-continuation _)
(let ((result (procedure yield)))
(last-return result)))
(define (yield value)
(call/cc (lambda (continuation)
(set! last-continuation continuation)
(set! last-value value)
(last-return value))))
(lambda args
(call/cc (lambda (return)
(set! last-return return)
(if (null? args)
(last-continuation last-value)
(apply last-continuation args))))))
(define test
(make-generator
(lambda (collect)
(collect 1)
(collect 5)
(collect 10)
#f)))
(test) ; ==> 1
(test) ; ==> 5
(test) ; ==> 10
(test) ; ==> #f (procedure finished)
One might make a macro to make the syntax more similar, but it's just sugar on top of this.
For more examples I love Matt Mights page with lots of examples on how to use continuations.
Here's code to define a generator:
(define-syntax define-generator
(lambda (x)
(syntax-case x (lambda)
((stx name (lambda formals e0 e1 ...))
(with-syntax ((yield (datum->syntax (syntax stx) 'yield)))
(syntax (define name
(lambda formals
(let ((resume #f) (return #f))
(define yield
(lambda args
(call-with-current-continuation
(lambda (cont)
(set! resume cont)
(apply return args)))))
(lambda ()
(call-with-current-continuation
(lambda (cont)
(set! return cont)
(cond (resume (resume))
(else (let () e0 e1 ...)
(error 'name "unexpected return"))))))))))))
((stx (name . formals) e0 e1 ...)
(syntax (stx name (lambda formals e0 e1 ...)))))))
There are examples of the use of generators at my blog. Generators use call-with-current-continuation, in a manner similar to yield in Python, but are much more general.
You can implement generators with call/cc. Here is an example:
coroutines.ss
They work in a similar way to python and ECMAScript generators.
I'm trying to write a macro in racket/scheme that operates like a for loop across some arbitrary code such that the body of the loop is unrolled. For example, the following code
(macro-for ((i '(0 1 2 3))
(another-macro
(with i)
(some (nested i))
(arguments (in (it (a b c i))))))
should have the same result as if the code had been written as
(another-macro
(with 0)
(some (nested 0))
(arguments (in (it (a b c 0))))))
(another-macro
(with 1)
(some (nested 1))
(arguments (in (it (a b c 1))))))
(another-macro
(with 2)
(some (nested 2))
(arguments (in (it (a b c 2))))))
I've made an attempt of implementing it but I'm new to macros and they don't seem to work as I expect them to. Here's my attempt - which doesn't compile because match apparently is not allowed to be used within macros - but hopefully it conveys the idea I'm trying to achieve.
(module test racket
(require (for-syntax syntax/parse))
(begin-for-syntax
(define (my-for-replace search replace elem)
(if (list? elem)
(map (lambda (e) (my-for-replace search replace e)) elem)
(if (equal? elem search)
replace
elem))))
(define-syntax (my-for stx)
(syntax-case stx ()
((my-for args-stx body-stx)
(let ((args (syntax-e #'args-stx)))
(if (list? args)
(map (lambda (arg)
(match arg
((list #'var #'expr)
(my-for-replace #'var #'expr #'body))
(else
(raise-syntax-error #f
"my-for: bad variable clause"
stx
#'args))))
args)
(raise-syntax-error #f
"my-for: bad sequence binding clause"
stx
#'args))))))
(define-syntax (my-func stx)
(syntax-parse stx
((my-func body)
#'body)))
(my-for ((i '(0 1 2)))
(my-func (begin
(display i)
(newline))))
)
Here's how I would write that (if I were going to write something like that):
First, we need a helper function that substitutes in one syntax object wherever an identifier occurs in another syntax object. Note: never use syntax->datum on something that you intend to treat as an expression (or that contains expressions, or definitions, etc). Instead, recursively unwrap using syntax-e and after processing put it back together just like it was before:
(require (for-syntax racket/base))
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (syntax-substitute stx id replacement)
(let loop ([stx stx])
(cond [(and (identifier? stx) (bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Unwrapped data cases:
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; FIXME: also traverse vectors, etc?
[else stx]))))
Use bound-identifier=? when you're implementing a binding-like relationship, like substitution. (This is a rare case; usually free-identifier=? is the right comparison to use.)
Now the macro just interprets the for-clause, does the substitutions, and assembles the results. If you really want the list of terms to substitute to be a compile-time expression, use syntax-local-eval from racket/syntax.
(require (for-syntax racket/syntax))
(define-syntax (macro-for stx)
(syntax-case stx ()
[(_ ([i ct-sequence]) body)
(with-syntax ([(replaced-body ...)
(for/list ([replacement (syntax-local-eval #'ct-sequence)])
(syntax-substitute #'body #'i replacement))])
#'(begin replaced-body ...))]))
Here's an example use:
> (macro-for ([i '(1 2 3)]) (printf "The value of ~s is now ~s.\n" 'i i))
The value of 1 is now 1.
The value of 2 is now 2.
The value of 3 is now 3.
Notice that it replaces the occurrence of i under the quote, so you never see the symbol i in the output. Is that what you expect?
Disclaimer: This is not representative of typical Racket macros. It's generally a bad idea to go searching and replacing in unexpanded forms, and there are usually more idiomatic ways to achieve what you want.
If the for-loop is to be evaluated at compile-time, you can use the builtin for loop.
#lang racket/base
(require (for-syntax syntax/parse
racket/base)) ; for is in racket/base
(define-syntax (print-and-add stx)
(syntax-parse stx
[(_ (a ...))
; this runs at compile time
(for ([x (in-list (syntax->datum #'(a ...)))])
(displayln x))
; the macro expands to this:
#'(+ a ...)]))
(print-and-add (1 2 3 4 5))
Output:
1
2
3
4
5
15
UPDATE
Here is an updated version.
#lang racket
(require (for-syntax syntax/parse racket))
(define-syntax (macro-for stx)
(syntax-parse stx
[(_macro-for ((i (a ...))) body)
(define exprs (for/list ([x (syntax->list #'(a ...))])
#`(let-syntax ([i (λ (_) #'#,x)])
body)))
(with-syntax ([(expr ...) exprs])
#'(begin expr ...))]))
(macro-for ((i (1 2 3 4)))
(displayln i))
Output:
1
2
3
4
Ryan Culpepper's answer only supports use of one induction variable, so here's an extension which supports multiple induction variables:
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (instr-syntax-substitute stx id replacement index)
(let loop ([stx stx])
(cond [(and (identifier? stx)
(bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Special handling of (define-instruction id ...) case
[(and (pair? stx)
(syntax? (car stx))
(equal? (syntax-e (car stx)) 'define-instruction))
(let ((id-stx (car (cdr stx))))
(cons (loop (car stx))
(cons (datum->syntax id-stx
(string->symbol
(format "~a_~a"
(symbol->string
(syntax-e id-stx))
index))
id-stx
id-stx)
(loop (cdr (cdr stx))))))]
;; Unwrap list case
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; Do nothing
[else stx]))))
(begin-for-syntax
(define instr-iter-index 0)
(define (instr-iter-arg body arg argrest)
(let loop ([body body]
[arg arg]
[argrest argrest])
(let ([i (car (syntax-e arg))]
[ct-sequence (cadr (syntax-e arg))]
[replaced-bodies '()])
(for ([replacement (syntax-e ct-sequence)])
(let ([new-body (instr-syntax-substitute body
i
replacement
instr-iter-index)])
(if (null? argrest)
(begin
(set! replaced-bodies
(append replaced-bodies (list new-body)))
(set! instr-iter-index (+ instr-iter-index 1)))
(let* ([new-arg (car argrest)]
[new-argrest (cdr argrest)]
[new-bodies (loop new-body
new-arg
new-argrest)])
(set! replaced-bodies
(append replaced-bodies new-bodies))))))
replaced-bodies))))
(provide instr-for)
(define-syntax (instr-for stx)
(syntax-case stx ()
[(instr-for args body)
(with-syntax ([(replaced-body ...)
(let ([arg (car (syntax-e #'args))]
[argrest (cdr (syntax-e #'args))])
(instr-iter-arg #'body arg argrest))])
#'(begin replaced-body ...))]))
I'm currently writing metacircular evaluator in Scheme, following the SICP book's steps.
In the exercise I am asked to implement letrec, which I do in the following way:
(define (letrec->let exp)
(define (make-unassigned var)
(list var '*unassigned*))
(define (make-assign binding)
(list 'set! (letrec-binding-var binding)
(letrec-binding-val binding)))
(let ((orig-bindings (letrec-bindings exp)))
(make-let
(map make-unassigned
(map letrec-binding-var orig-bindings))
(sequence->exp
(append
(map make-assign orig-bindings)
(letrec-body exp))))))
However, when I evaluate the expression as follows, it goes into infinite loop:
(letrec
((a (lambda () 1)))
(+ 1 (a)))
Do I miss anything?
(Full Source Code at GitHub).
I checked result transformation result of (let ((x 1)) x) and got:
((lambda (x) (x)) 1)
instead of:
((lambda (x) x) 1)
obviously problem is in let body processing. If I were you, I would use utility function:
(define (implicit-begin exps)
(if (= 1 (length x))
(car x)
(cons 'begin x)))
By the way: I would say, that your letrec implementation is not very correct. Your transformation returns:
(let ((x1 *unassigned*>) ... (xn *unassigned*))
(set! x1 ...)
...
(set! xn ...)
body)
It much more resembles letrec* which evaluates expressions for variable bindings in left-ro-right order (Scheme itself doesn't specify arguments evaluation order):
syntax: letrec* bindings body
Similar to ‘letrec’, except the INIT expressions are bound to their
variables in order.
‘letrec*’ thus relaxes the letrec restriction, in that later INIT
expressions may refer to the values of previously bound variables.
The more correct code would be:
(let ((x1 *unassigned*) ... (xn *unassigned*))
(let ((t1 ...) ... (tn ...))
(set! x1 t1)
...
(set! xn tn))
body)
I have written a function match-rewriter that is essentially match-lambda except that it returns its argument if no match is found:
(define-syntax match-rewriter
(syntax-rules ()
((_ (patt body) ...)
(λ (x) (match x (patt body) ... (_ x))))))
Now I would like to use match-rewriter to take strings representing source code for let* and rewrite it as nested unary lets:
(define let*→nested-unary-lets
(match-rewriter (`(let*((,<var> ,<val>) ...) ,<expr1> ,<expr2> ...)
I am really stumped over how to pattern match this. I need to return:
`(let((,<var1> ,<val1>)) let((,<var2> ,<val2>)) let((...)) ... )...) ,<expr1> . ,#<expr2>)
But the nesting has me stumped. Any advice is appreciated.
Okay, here is my best attempt:
(define let*→nested-unary-lets
(match-rewriter
(`(let* (()) ,<expr1> ,<expr2> ...)
(`(let () ,<expr1> . ,<expr2>)))
(`(let* ((,<var1> ,<val1>) (,<var2> ,<val2>) ...) ,<expr1> ,<expr2> ...)
`(let ((,<var1> ,<val1>) (let*→nested-unary-lets
'(let* ((,<var2> ,<val2>) ...) ,<expr1> . ,<expr2>)))))
))
But this is how it behaves:
(let*→nested-unary-lets '(let* ((a 1) (b (+ a 1)) (c (+ a b))) (displayln c)))
'(let ((a 1)
(let*→nested-unary-lets
'(let* (((b c) ((+ a 1) (+ a b)))
...)
(displayln c)))))
I am confused about the order of the arguments in:
(let* (((b c) ((+ a 1) (+ a b)))
It seems to me it should be:
(let* ((b (+ a 1)) (c (+ a b)))
Also, it would be nice if the call to let*→nested-unary-lets would execute instead of just printing as text.
Yes, you can do this; it shouldn't be too difficult. Specifically, the key idea you need here is not to try to handle the whole list at once. Instead, your patterns should separate the first binding from the rest, and then wrap one let around a recursive call to let*->nested-unary-lets.
Let me know if you have trouble formulating this.
Here is a definition of let* in syntax-rules-like pseudocode that you can use to write your own version:
(let* ((a b) (c d) ...) body ...) === (let ((a b)) (let* ((c d) ...) body ...))
(let* () body ...) === body
You should be able to turn that into a function using match or a macro using syntax-rules.