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)))
Related
How can I test whether a syntax pattern parameter is an empty list? I am testing in guile.
(define-syntax mkl
(lambda (x)
(syntax-case x ()
[(_ var params code)
(if (null? (syntax->datum #'params)); doesn't match anyway !!!???
#'(lambda (var) code)
#'(lambda (var) (cons 1 code)))])))
;;; try: expecting: (100 200) but got: (1 100 200)
(display
((mkl s '() s) '(100 200)))
(newline)
However, if I test against a number, it works:
(define-syntax mkl2
(lambda (x)
(syntax-case x ()
[(_ var params code)
(if (= (syntax->datum #'params) 0); matches OK
#'(lambda (var) code)
#'(lambda (var) (cons 1 code)))])))
;;; try: expecting: (100 200) and it works OK
(display
((mkl2 s 0 s) '(100 200)))
(newline)
It appears that there's an extra quotation in there. In the macro, you should perform the check like this:
(if (null? (cadr (syntax->datum #'params))) ; access the actual list
Or as a workaround, you could call the macro like this:
((mkl s () s) '(100 200)) ; quote was removed
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 trying to create a function in Guile which tests if an arbitrary expression threw an error or not, but have hit a wall.
(define (error-or-not qqx)
(if
(catch
#t
(lambda () ,qqx)
(lambda (k . args) #t))
#t
#f))
(display (error-or-not `(/ 1 0))) ; => #t (1)
(newline)
(display (error-or-not `(/ 1 1))) ; => #t (2)
(newline)
qqx is a quasiquoted expression that is evaluated inside the error-or-not function and tested to see if it causes an error.
The Guile manual in effect says that, if evaluating qqx throws an error, the catch function returns the value it gets from calling its third argument (the lambda which takes the arguments). This works fine if qqx actually does cause an error (see above #1).
But the manual also says that if there is no error, the catch function returns the value from evaluating qqx. This is not working out so well for me because I can't distinguish between the two cases (see above #2).
Can someone point out how to definitively tell when an error did not occur?
Update
Chris Jester-Young has pointed out my mistake--see the accepted answer below. For completeness, I'm posting the version of his code I'm using (backported to Guile 1.8.8):
(use-syntax (ice-9 syncase))
(define (stub retval) (lambda args retval))
(define-syntax error-or-not
(syntax-rules ()
((_ expr ...)
(catch #t (lambda () expr ... #f) (stub #t)))))
(display (error-or-not (/ 1 0))) ; => #t
(newline)
(display (error-or-not (/ 1 1))) ; => #f
(newline)
You are misusing quasiquoting; it doesn't do what you expect. In particular, it isn't a substitute for eval. The (lambda () ,qqx) you have creates a function that always fails when called, because unquote cannot be used outside of a quasiquote form.
The best way to implement the functionality you want is as a macro:
(define-syntax-rule (error-or-not expr ...)
(catch #t
(lambda () expr ... #f)
(const #t)))
Example:
(error-or-not (/ 1 0)) ; => #t
(error-or-not (/ 1 1)) ; => #f
Guile 1.8-compatible version:
(use-syntax (ice-9 syncase))
(define-syntax error-or-not
(syntax-rules ()
((_ expr ...)
(catch #t (lambda () expr ... #f)
(lambda _ #t)))))
After reading this page. I find it hard to memorize how to use define-syntax in place of define-macro, so I want to implement define-macro (or at least find some equivalent) in mit-scheme.
Here is my (problematic) implementation:
(define-syntax define-macro
(rsc-macro-transformer
(let ((xfmr (lambda (macro-name macro-body)
(list 'define-syntax macro-name
(list 'rsc-macro-transformer
(let ((m-xfmr macro-body))
(lambda (e r)
(apply m-xfmr (cdr e)))))))))
(lambda (e r)
(apply xfmr (cdr e))))))
(define-macro my-when
(lambda (test . branch)
(list 'if test (cons 'begin branch))))
(my-when #t
(begin
(display "True")
(newline)))
And the REPL complained:
;The object (lambda (test . branch) (list (quote if) test (cons (quote begin) branch))) is not applicable.
I'm new to scheme and have no idea about what is wrong, can someone help me out?
Firstly, you should learn to use quasiquotation, so your macro is easier to read. Like this:
(define-macro (my-when test . branch)
`(if ,test
(begin ,#branch)))
More seriously, though, this is pretty easy to write using syntax-rules, and you really should vastly prefer it over define-macro.
(define-syntax-rule (my-when test branch ...)
(if test
(begin branch ...)))
Oh, you haven't seen define-syntax-rule before? It's a simple macro you can use for writing a one-clause define-syntax macro, and it's defined so:
(define-syntax define-syntax-rule
(syntax-rules ()
((define-syntax-rule (name . pattern) template)
(define-syntax name
(syntax-rules ()
((name . pattern) template))))))
Notice how, using define-syntax-rule, simple macros become really, really easy to write. Here's another example:
(define-syntax-rule (let ((name value) ...)
expr ...)
((lambda (name ...)
expr ...)
value ...))
If you really need define-macro semantics, you can get a reasonable approximation in mit-scheme like so:
(define-syntax define-macro
(syntax-rules ()
((define-macro (name . args) body ...)
(define-syntax name
(rsc-macro-transformer
(let ((transformer (lambda args body ...)))
(lambda (exp env)
(apply transformer (cdr exp)))))))))
You could then define my-when as:
(define-macro (my-when test . branch)
`(if ,test (begin ,#branch)))
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.