is it possible to implement "define-macro" in mit-scheme - scheme

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

Related

evaluating forms during macro expansion in Racket

This Common Lisp macro and test function
(defmacro test (body)
`(let ,(mapcar #'(lambda (s)
`(,s ,(char-code (char-downcase (char (symbol-name s) 0)))))
'(a b))
,body))
(test (+ a b))
expands into
(let ((a 97) (b 98))
(+ a b))
and gives 195 when evaluated
Trying to do that in Racket
(define-syntax (test stx)
(syntax-case stx ()
[(_ body)
#`(let #,(map (lambda (x)
(list x
(char->integer (car (string->list (symbol->string x))))))
'(a b))
body)]))
(test (+ a b))
When I run the macroexpander, the macro form expands to:
(let ((a 97) (b 98)) (+ a b))))
which is what I thought I wanted.
But it fails with:
a: unbound identifier in context..
Disabling macro hiding gives a form that ends with:
(#%app:35
call-with-values:35
(lambda:35 ()
(let-values:36 (((a:37) (quote 97)) ((b:37) (quote 98)))
(#%app:38 + (#%top . a) b)))
(print-values:35)))
I don't understand why my nice expansion (let ((a 97) (b 98)) (+ a b)) doesn't work, and I'm puzzled by (#%top .a)... I wonder if it's trying to find a function called "a"?
When I copy the expanded form into the REPL, it works...
I'm grateful for any help!
Racket has hygienic macro. Consider:
(define-syntax-rule (or a b)
(let ([a-val a])
(if a-val a-val b)))
Then:
(let ([a-val 1])
(or #f a-val))
will roughly expand to:
(let ([a-val 1])
(let ([a-val2 #f])
(if a-val2 a-val2 a-val)))
which evaluates to 1. If macro is not hygienic, then it would result in #f, which is considered incorrect.
Notice that a-val is renamed to a-val2 automatically to avoid the collision. That's what happens to your case too.
One way to fix the problem in your case is to give a correct context to the generated identifiers so that the macroexpander understands that they should refer to the same variable.
(define-syntax (test stx)
(syntax-case stx ()
[(_ body)
#`(let #,(map (lambda (x)
(list (datum->syntax stx x) ; <-- change here
(char->integer (car (string->list (symbol->string x))))))
'(a b))
body)]))
(test (+ a b))
As a counterpart Sorawee Porncharoenwase's answer (which is the right answer) I think it's worth while thinking a bit about why your test macro is problematic in CL and why macros which do similar things are outright buggy.
Given your test macro, imagine some user looking at this code:
(let ((a 1) (b 2))
(test (+ a b)))
Well, I don't know about you, but what I would expect to happen is that the a and b inside test are the a and b I've just bound. But that's not the case at all, of course.
Well, perhaps the documentation for test describes in great detail that it binds two variables, and that this is what I should expect. And, of course, there are macros which do just that, and where it's fine:
(defmacro awhen (test &body forms)
`(let ((it ,test))
(when ,it ,#forms)))
And now:
(awhen (find-exploder thing)
(explode it))
And this is all fine, because the documentation for awhen will say that it binds it to the result of the test in its body.
But now consider this or macro stolen from the other answer:
(defmacro vel (a b)
`(let ((a-val ,a))
(if a-val a-val ,b)))
This is a disaster. It 'works', except it doesn't work at all:
> (let ((a-val 3))
(vel nil a-val))
nil
Now that's not just surprising in the way your test macro is: it's wrong.
Instead, you have to write vel like this in CL:
(defmacro vel (a b)
(let ((a-val-name (make-symbol "A-VAL")))
`(let ((,a-val-name ,a))
(if ,a-val-name ,a-val-name ,b))))
(You can of course use gensym instead of make-symbol, and most people do I think.)
And now
> (let ((a-val 3))
(vel nil a-val))
3
as you would expect.
This is all because the CL macro system is unhygenic – it relies on you to ensure that things like names do not clash. In CL you have to go slightly out of your way to write macros which are correct in many cases. The Racket macro system, on the other hand, is hygenic: it will by default ensure that names (and other things) don't clash. In Racket (and Scheme) you have to go out of your way to write macros which are either incorrect or do something slightly unexpected like introducing bindings visible from code which makes use of the macros.
Note that I'm not expressing a preference for either approach to macros: I've spent most of my life writing CL, and I'm very happy with its macro system. More recently I've written more Racket and I'm happy with its macro system as well, although I find it harder to understand.
Finally here is a variant of your macro which is less surprising in use (almost all of the noise in this code is sanity checking which syntax-parse supports in the form of the two #:fail-when clauses):
(define-syntax (with-char-codes stx)
(syntax-parse stx
[(_ (v:id ...) form ...)
#:fail-when (check-duplicate-identifier (syntax->list #'(v ...)))
"duplicate name"
#:fail-when (for/or ([name (syntax->list #'(v ...))])
(and (> (string-length (symbol->string
(syntax->datum name)))
1)
name))
"name too long"
#'(let ([v (char->integer (string-ref (symbol->string 'v) 0))] ...)
form ...)]))
And now
> (with-char-codes (a b)
(+ a b))
195

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

Cond definition in scheme

This will be an easy question I guess but I need it.I am making a simulator game in scheme(Dr Racket)and I want to change how cond works.But to change the thing cond does I need to know the definition of cond and I could not find it in Dr racket.Can someone give the definition of cond in scheme?
The Racket definition of cond is in collects/racket/private/cond.rkt. It's written using low-level syntax object operations, not using either syntax-rules nor syntax-case, so unless you know syntax objects very well, it won't be readable to you.
As an alternative starting place for your customised cond, one definition of cond is the reference implementation given in SRFI 61. It is succinct and is one of the best implementations of cond I've seen:
(define-syntax cond
(syntax-rules (=> else)
((cond (else else1 else2 ...))
;; The (if #t (begin ...)) wrapper ensures that there may be no
;; internal definitions in the body of the clause. R5RS mandates
;; this in text (by referring to each subform of the clauses as
;; <expression>) but not in its reference implementation of cond,
;; which just expands to (begin ...) with no (if #t ...) wrapper.
(if #t (begin else1 else2 ...)))
((cond (test => receiver) more-clause ...)
(let ((t test))
(cond/maybe-more t
(receiver t)
more-clause ...)))
((cond (generator guard => receiver) more-clause ...)
(call-with-values (lambda () generator)
(lambda t
(cond/maybe-more (apply guard t)
(apply receiver t)
more-clause ...))))
((cond (test) more-clause ...)
(let ((t test))
(cond/maybe-more t t more-clause ...)))
((cond (test body1 body2 ...) more-clause ...)
(cond/maybe-more test
(begin body1 body2 ...)
more-clause ...))))
(define-syntax cond/maybe-more
(syntax-rules ()
((cond/maybe-more test consequent)
(if test
consequent))
((cond/maybe-more test consequent clause ...)
(if test
consequent
(cond clause ...)))))
(As molbdnilo says, though, please call your version something other than cond to avoid confusion.)
r5rs describes cond here: http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-7.html#%_sec_4.2.1
You would normally implement it as a macro.

Is there a Scheme toString method for a procedure?

I want to be able to take a procedure and see what it looks like. Is this possible?
For example, let's say I have:
(define (some-func x)
(+ x 1))
What I want to do is apply some amazing function (say, stringify) to some-func and be able to look at its guts.
\> (stringify some-func)
"(lambda (x) (+ x 1))"
I haven't found any Racket libraries that do it. Can it be done?!
In R6RS, there is no sure way to determine if two procedures are equivalent; even an expression like (let ((p (lambda () 42))) (eqv? p p)) is not guaranteed to be true.
R7RS addresses that by using the concept of "location tags", where each lambda expression generates a unique location tag. Then eqv? works for procedures by comparing location tags: thus, (let ((p (lambda () 42))) (eqv? p p)) is true, and (eqv? (lambda () 42) (lambda () 42)) is false.
There is no reliable way to get the source of a procedure (many implementations macro-expand and compile the procedures, discarding the original source), and even if you could, you could not use it to compare if two procedures are "equal", because of closures (and that two procedures could have the same "source" but have their free variables bound to different things). For example, consider the two expressions (let ((x 1)) (lambda () x)) and (let ((x 2)) (lambda () x)). They have the same "source", but nobody in their right mind would claim that they are equivalent in any way.
Note, you could easily implement a define alternative to keep the source around. You don't avoid the lexical issues but, modulo that, you've got something with limited use.
(define name->source-mapping '())
(define (name->source name)
(cond ((assq name name->source-mapping) => cdr)
(else #f)))
(define (name->source-extend name source)
(set! name->source-mapping (cons (cons name source) name->source-mapping))
(define-syntax define-with-source
((_ (name args ...) body1 body2 ...)
(define name
(begin (name->source-mapping-extend 'name '(lambda (args ...) body1 body2 ...))
name->source-mapping))
(lambda (args ...) body1 body2 ...)))))
[Above does not replace (define name value) syntax; consider the above an example only.]

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