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

Question

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


)

Artichoke

Answer 1

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.

Gulgee

I get an error: application: not a procedure; expected a procedure that can be applied to arguments given: 0 arguments...: 1 2 context...: /usr/racket/collects/racket/syntax.rkt:191:0: syntax-local-eval26 /home/ghb/dump/scheme/test.rkt:49:0 /usr/racket/collects/syntax/wrap-modbeg.rkt:46:4 – Artichoke

Never mind, I solved it by replacing syntax-local-eval with syntax-e; I don't need the expressions to be evaluated at compile-time. – Artichoke

Answer 2

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

Fructose

I think I should have been more detailed in my question, because this is not what I'm looking for. Please see updated question. – Artichoke

Answer 3

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

Artichoke