Literals in syntax-rules don't work in libraries in Scheme - scheme

I want to define new syntax. If I define it without a library, just
(define-syntax sample1
(syntax-rules (:times)
[(_ n :times body ...)
(list n (sample1 body ...))]
[(c body ...)
'(body ...)]))
it works as expected, but if I put it in a library:
(library (alib)
(export sample2)
(import
(rnrs))
(define-syntax sample2
(syntax-rules (:times)
[(_ n :times body ...)
(list n (sample2 body ...))]
[(c body ...)
'(body ...)])))
the :times literal stops working. It works if I replace :times with a literal present in an already existing macro, like => or else.
Here's full example in Chez:
(define-syntax sample1
(syntax-rules (:times)
[(_ n :times body ...)
(list n (sample1 body ...))]
[(c body ...)
'(body ...)]))
(sample1 a b c d)
;; => (a b c d)
(sample1 10 :times a b c d)
;; => (10 (a b c d))
(library (alib)
(export sample2)
(import
(rnrs))
(define-syntax sample2
(syntax-rules (:times)
[(_ n :times body ...)
(list n (sample2 body ...))]
[(c body ...)
'(body ...)])))
(import (alib))
(sample2 10 :times a b c d)
;; => (10 :times a b c d)

This seems to work:
Chez Scheme Version 9.5.7.6
> (library (alib)
(export sample2 :times)
(import
(rnrs))
(define :times #f)
(define-syntax sample2
(syntax-rules (:times)
[(_ n :times body ...)
(list n (sample2 body ...))]
[(_ body ...)
'(body ...)])))
> (import (alib))
> (sample2 10 :times a b c d)
(10 (a b c d))
>
To use a literal (auxiliary keyword) in multiple libraries, define in a library imported by the syntax defining libraries:
(library (literals)
(export :times)
(import (rnrs))
(define :times #f))
(library (alib)
(export sample1 :times)
(import (rnrs) (literals))
(define-syntax sample1
...
(library (blib)
(export sample2 :times)
(import (rnrs) (literals))
(define-syntax sample2
...

You can use fender expressions as an alternative to auxiliary keywords.
(library (alib)
(export sample2)
(import
(chezscheme)) ;; <= required for syntax-rules fenders
(define-syntax sample2
(syntax-rules ()
[(_ n :times body ...)
(eq? (datum :times) ':times) ;; <= fender
(list n (sample2 body ...))]
[(c body ...)
'(body ...)])))
(import (alib))
(sample2 10 :times a b c d) ;; => (10 (a b c d))
Define a keyword? macro to make the fender cleaner.
(library (meta)
(export keyword?)
(import (chezscheme))
(define-syntax keyword?
(syntax-rules ()
[(_ x) (eq? (datum x) 'x)])))
(library (alib)
(export sample2)
(import (meta) (chezscheme))
(define-syntax sample2
(syntax-rules ()
[(_ n :times body ...)
(keyword? :times)
(list n (sample2 body ...))]
[(c body ...)
'(body ...)])))
(import (alib))
(sample2 10 :times a b c d) ;; => (10 (a b c d))

Related

How to write a self currying lambda macro in scheme? [duplicate]

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.

print symbol and evaluate it with a macro

I am trying to write some code to print a symbol and evaluate the function associated with it in racket
I already managed to achieve this at runtime using eval, but I think this ought to be possible also without using eval.
Eval version:
(define ns (namespace-anchor->namespace a))
(define (deco-display fun-sym bstr)
(display (symbol->string fun-sym))
(display ": ")
(display (eval `(,fun-sym ,bstr) ns)))
example usage:
(define (extract-id bstr) (subbytes bstr 0 8 ))
(deco-display 'extract-id bstr)
I tried:
(define (xxx) (display "asdas"))
(define-syntax (print-and-do stx)
(syntax-case stx ()
[(_ p) #`(begin (display #'p) (newline) (p))]))
but the outcome is not what I expected
(print-and-do xxx)
.#<syntax:interactions from an unsaved editor:5:16 xxx>
asdas
Thanks to people commenting and some more reading I wrapped up 3 working versions:
(define-syntax (print-and-do-v1 stx)
(syntax-case stx ()
[(_ p) #'(begin (display (syntax->datum #'p)) (newline) (p))]))
(define-syntax (print-and-do-v2 stx)
(syntax-case stx ()
[(_ p) #'(begin (display 'p) (newline) (p))]))
(define-syntax-rule (print-and-do-v3 p)
(begin (display 'p) (newline) (p)))

scheme - quotation and auxiliary syntax

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.

Macro that unrolls a 'for' loop in racket/scheme?

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 ...))]))

How to write a macro that maintains local state?

This seems to work, it's a macro that expands to successive integers depending on how many times it has been expanded.
;; Library (test macro-state)
(library
(test macro-state)
(export get-count incr-count)
(import (rnrs))
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1)))
)
;; Program
(import (rnrs) (for (test macro-state) expand))
(define-syntax m
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count)))))))
(write (list (m) (m) (m)))
(newline)
;; prints (1 2 3)
But it's clumsy to me because the macro state *count* and the macro m itself are in different modules. Is there a better way to do this in r6rs, preferably one that doesn't split the implementation over two modules?
EDIT
I should make it clear that although this example is just a single macro, in reality I'm looking for a method that works when multiple macros need to share state.
You can make the state local to the macro transformer:
(define-syntax m
(let ()
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1)))
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count))))))))
Edited to add: In Racket, you can also do this:
(begin-for-syntax
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1))))
(define-syntax m
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count)))))))
But I don't think R6RS has anything that corresponds to begin-for-syntax.

Resources