The Common Lisp LOOP Macro for Racket
<*>
1 Introduction
<define-end-of-generator>
2 Enabling return
<return>
3 The Main Body
3.1 Variables That Hold Various Sections of Generated Code
3.2 Variables representing identifiers
<loop-body>
<exit-loop>
<increment-lists>
4 Handling Conditional Statements
4.1 Rewrite when and unless clauses
<rewrite-if-clauses>
4.2 Collect consecutive if clauses
<collect-if-clauses>
4.3 Collect else and else if clauses
<collect-else-if>
4.4 AND
<and>
4.5 END
<end>
<add-cond-clause>
5 Action clauses
<do-clause>
5.1 Unavoidable boilerplate
<action-boilerplate-guard>
<define-add-action-clause>
<action-boilerplate>
<do-internal>
<do-internal/2>
5.2 Other Action Clauses
5.2.1 collect
<collect-clause>
<collect-into>
5.2.2 cons
<cons-into>
5.2.3 collect variants
<generate-collection-type>
<list->hash>
<with-collection-type>
5.2.4 append
<append-clause>
5.2.5 sum
<sum-clause>
5.2.6 count
<count-clause>
5.2.7 minimize and maximize
<min/max>
6 While and Until
<while/until>
7 Repeating a Set Number of Times
<repeat>
8 Iterating over stuff
<universal-for-clause>
8.1 for x in y:   List and Hash Iteration
<for-x-in-y>
<destructuring-for-x-in-y>
<extract-variables-from-pattern>
8.2 for x on y by iterator:   List iteration with entire lists.
<for-x-on-y>
8.3 for x being the hash-keys in table:   Hash iteration
<for-hash>
<make-hash-generator>
8.3.1 for x being the hash-keys in hash using...
<for-hash-keys>
<for-hash-values>
8.4 for x over y:   Generator iteration
<for-x-over-y>
8.5 for x across y:   Vector, string, and byte iteration
<for-x-across-y>
8.6 for x = y:   Iterating over numbers
<for-x=y>
<for-x=y-then>
<for-x-from-low>
<for-x-from-low-to-high>
<individual-for-clauses>
9 WITH:   Binding variables
<with>
10 FINALLY
<finally>
11 INITIALLY
<initially-clause>
12 always, never, and thereis
<always/never/thereis>
<loop-literals>
<all-the-rest>
<local-macros>
<supporting-functions>
Zero

The Common Lisp LOOP Macro for Racket

Anonymous

<*> ::=
(require
 (for-syntax racket)
 (for-syntax "set-values.rkt")
 "set-values.rkt"
  racket/generator)
<define-end-of-generator>
<local-macros>
<supporting-functions>
<return>
<add-cond-clause>
<make-hash-generator>
<all-the-rest>
(define (macroexpand-1 datum)
  (syntax->datum (expand-once datum)))
(provide macroexpand-1)

1 Introduction

This is an implementation of Common Lisp’s LOOP macro for Racket. The LOOP macro is similar to all of Racket’s for/* macros, combined with Python’s for loop, except it’s more powerful than either.

Examples:

(define (sift pred? list)
  (loop for value in list
        when (pred? value) consing value into gold
        else consing value into dirt
        finally (return (values (reverse gold) (reverse dirt)))))
> (loop for x in '(a b c d e f g)
        for y from 0
        when (even? y)
        collect x)

(a c e g)

> (loop for x in '(a b c d e f g)
        for y in '(1 2 3 4 5 6 7)
        with-collection-type hash
        collect (cons x y))

#hash((g . 7) (b . 2) (a . 1) (c . 3) (d . 4) (e . 5) (f . 6))

LOOP can also do the job of for/and:

(loop for x in a-list
      for y in another-list always (and (number? x)
                                        (symbol? y)))

...or for/or:

(loop for x in a-list thereis (symbol? x))

...or for/sum:

(loop for x in a-list when (integer? (sqrt x)) sum x)

...or you can convert a list into a hash table:

(loop with collection-type 'hash/immutable
       for key-value in '((key . val) (key2 . val2))
       collect key-value)

...or you can write an old-fashioned while loop:

(loop for line = (read-line socket)
      while (not (eof-object? line))
      do
        (display line)
        (newline)
      finally
        (close-input-port socket))

The loop macro can also iterate over generators as defined in the racket/generator package.

(loop for item in (gen)
      do
        (displayln item))

Since racket/generator provides no non-ambiguous way to end a generator, arrange for your generator to yield the value end-of-generator to terminate the loop, or use an explicit return clause to exit.

(define-struct end-of-generator* ())
(define end-of-generator (make-end-of-generator*))
(define end-of-generator? end-of-generator*?)
(provide end-of-generator end-of-generator?)

2 Enabling return

In Common Lisp, the LOOP macro is often used in conjunction with return and return-from. Racket makes it extremely difficult to make identifiers be implicitly bound within a given code block. Instead, this library defines return as a macro which invokes a continuation that can be tucked away within this module.

return is defined as a macro and not a function because in Common Lisp, it’s legal to do this:

(return (values 1 2 3 4))

...where Racket would tend to discourage this. return and its hidden continuation are defined as follows:

(define return-cc (make-parameter #f))
 
(define-syntax return
  (syntax-rules ()
    ((_) (return (void)))
    ((_ value-form)
     (call-with-values (λ () value-form)
       (λ all-values
          (apply (return-cc) all-values))))))
(define-syntax return-from
  (syntax-rules ()
    ((_ block-name value-form)
     (parameterize ((return-cc block-name))
        (return value-form)))))
(provide return return-from)

When the LOOP macro is invoked, it sets the return-cc parameter with its own continuation, which is only an escape continuation.

3 The Main Body

3.1 Variables That Hold Various Sections of Generated Code

The main body of the macro iterates over all the clauses and builds the following variables:

3.2 Variables representing identifiers

References to identifiers in the <loop-body> below need to be made from the code in the variables above, and this code is generated outside of the scope of the <loop-body>. Because of Racket’s hygienic macros, the only way to do this is to put the identifiers themselves into variables that have a wider scope. Some of these identifiers are just the names of variables within the local-loop block, but others may be changed during macro expansion:

These variables can then be combined to form the loop itself, as it will eventually be expanded.:

#`(let ((#,collection #,initial-collection)
        (#,count* #,initial-count)
        (#,sum* #,initial-sum)
        (#,min #f)
        (#,max #f)
        (#,string-accumulator #,initial-string)
        (#,reverse? #,reverse-value)
        #,@let-defs
        #,@list-defs)
    (#,call-with-cc
     (λ (#,return-continuation)
        (parameterize
         ((return-cc #,return-continuation))
         (gnarled-let-nest
          #,gnarled-let-defs
          (begin
            #,@prologue
            #,@initially-prologue
            (let local-loop ()
              (let-values
                  #,let-values-defs
                #,@preiterations
                (unless (and . #,loop-preconditions)
                        <exit-loop>)
                (begin . #,body)
                (begin . #,<increment-lists>)
                (begin . #,iterations)
                (cond ((and . #,loop-conditions)
                       (local-loop))
                      (else
                       <exit-loop>))))))))))

(begin
  #,@epilogue
  (#,return-continuation (or <generate-collection-type> count sum (void))))

The return-continuation is used for all exits from the loop.

All the lists being iterated over are handled separately from the recursion process. Each list has a corresponding variable that is bound to the next element of the list via the car function. This binding is all that takes place during the iterations, and must happen after the lists themselves have been cdr’d off.

(let unroll-lists ((list-names (get-let-vars list-defs))
                   (result #'()))
  (syntax-case list-names ()
    (() result)
    ((var . rest)
     (unroll-lists #'rest #`((set! var (cdr var)) . #,result)))))

4 Handling Conditional Statements

Common Lisp’s LOOP facility allows the use of if and else clauses that alter the behavior of the loop. Expansion of these clauses proceeds as follows:

  1. Rewrite all when clauses as if clauses

  2. Rewrite all if foo and bar as if foo if bar

  3. Collect all consecutive if foo clauses into current-condition

  4. If an action clause (such as do, collect, count, etc) is encountered while a current-condition exists, combine the action clause and the current-condition into a clause that can be added to a cond form (current-cond-body). The and operator is added to the front of the current-condition list, unless current-condition is the word else.

  5. After an action clause, an else clause can be encountered, which goes into the current-condition, ultimately adding another clause to the current-cond-body when an action clause is encountered.

  6. If an end clause is encountered, a cond statement is created with the current-cond-body and added to the body.

  7. If an if clause is encountered after if condition action-clause ..., rewrite it as if it was preceded by end.

4.1 Rewrite when and unless clauses

The chunk of code below is evaluated within the context of a syntax-case macro called loop-body.

((_ (when . rest))
 (parse-loop #`(loop-body (if . rest))))
((_ (unless condition . rest))
 (parse-loop #`(loop-body (if (not condition) . rest))))
((_ (else unless condition . rest))
 (parse-loop #`(loop-body (else if (not condition) . rest))))

4.2 Collect consecutive if clauses

((_ (if condition else . rest))
 (raise-syntax-error 'if-else "An action clause (such as do, collect, sum, etc) must occur between an if clause and an else clause"
                     #'(if condition else . rest)))
((_ (if condition . rest))
 (begin
   (set! current-condition #`(condition . #,current-condition))
   (set! and? #t)
   (parse-loop #'(loop-body rest))))

4.3 Collect else and else if clauses

((_ (else if condition . rest))
 (begin
   (set! current-cond-body
         (add-cond-clause current-condition action-clauses current-cond-body))
   (set! current-condition #`(condition))
   (set! and? #t)
   (set! action-clauses #'())
   (parse-loop #'(loop-body rest))))
((_ (else . rest))
 (begin
   (set! current-cond-body
         (add-cond-clause current-condition action-clauses current-cond-body))
   (set! current-condition #'else)
   (set! and? #t)
   (set! action-clauses #'())
   (parse-loop #'(loop-body rest))))

4.4 AND

If AND appears after an action clause, then a subsequent action clause will be part of the previous conditional.

<and> ::=
((_ (and . rest))
 (begin
   (set! and? #t)
   (parse-loop #'(loop-body rest))))

4.5 END

The end clause denotes the end of conditional processing. Action clauses after this will be treated as unconditional. Whatever current-cond-body is being built gets inserted into the body at this point.

<end> ::=
((_ (end . rest))
 (begin
   (when (and (syntax-null? current-condition)
              (syntax-null? current-cond-body))
         (raise-syntax-error 'end "end must be preceded by an if, when, or unless clause and an action clause." stx))
   (set! and? #f)
   (unless (syntax-null? current-condition)
           (set! current-cond-body (add-cond-clause current-condition action-clauses current-cond-body))
           (set! action-clauses #'())
           (set! current-condition #'()))
   (set! body #`(#,@body (cond . #,(syntax-reverse current-cond-body))))
   (set! current-cond-body #'())
   (parse-loop #'(loop-body rest))))

(define-for-syntax (add-cond-clause condition cond-body current-cond-body)
  #`((#,(fix-current-condition condition)
      . #,cond-body) . #,current-cond-body))
 
(define-for-syntax (fix-current-condition condition)
         (syntax-case condition (else)
                     ((hd . tl) #`(and . #,(syntax-reverse condition)))
                     (else condition)))

5 Action clauses

The action clauses are where the current-condition gets combined with some code to add to a current-cond-body.

Most action clauses only accept one form as an argument, but the do clause is special. Any compound form (ie, one surrounded by parentheses) following the do clause is part of the action clause, and a do without an action clause is illegal. This means the do form cannot be processed by rewriting it into another do form. Instead, it is rewritten as a do-internal form, which is ignored if the form following it is not a compound form.

((_ (do (hd . tl) (hd2 . tl2) . rest))
 (parse-loop #'(loop-body (do-internal (hd . tl) and do-internal (hd2 . tl2) . rest))))
((_ (do (hd . tl) . rest))
 (parse-loop #'(loop-body (do-internal (hd . tl) . rest))))
((_ (do non-list . rest))
 (raise-syntax-error 'do "Missing compound-form after do" #'(do non-list . rest)))

5.1 Unavoidable boilerplate

There are various chores that each action clause must accomplish on its own. Unfortunately, macro hygiene makes it impossible to define macros to do it. The macros must be defined in a separate file due to limitations in Racket, and due to the hygiene, local variables here wouldn’t be visible to the code generated by the macro.

One thing that each action clause must do is detect whether two action clauses have been written in a row, which breaks the conditional. For example in the following code:

(loop for x from 1 to 10 if (even? x) collect x do (displayln x))

..the do clause should be interpreted as if it was preceded by an end clause. That is, the cond form that goes with the if clause should be generated before generating the code that implements the do clause. The check for whether this should be done is:

(or and?
    (syntax-null? current-condition))

The current-condition is the boolean expression (missing its and operator) that determines whether the action-clause should be executed. If there is no current-condition, then that means the action-clause being processed should be executed unconditionally. But if even if there is a current-condition, it may be a stale current-condition left over from a previous action-clause. The current-condition is only fresh if the and? flag is set.

Therefore, if the above expression is true, it is safe to go ahead and process the action clause, otherwise an end clause must be inserted and processed first. The code to do the inserting varies between action clauses just enough to prevent it from being put in a chunk.

After the action-clause needs no further preprocessing, the next thing that must happen is that some code must be generated. What exactly is generated differs between each action-clause, but all action-clause generated code goes into a list, where it is later either placed into a cond form, or added naked to the body.

The generated snippet of code is added with this function:

(define (add-action-clause clause)
  (set! action-clauses #`(#,@action-clauses #,clause)))

After adding its action-clause code to the action-clauses using add-action-clause, every action-clause must check if the clause is conditional or not. If the clause is conditional (that is, if current-condition is non-empty), then the action-clauses are left alone for later processing, and the body is not modified, as this will be handled in the end clause. But if the action-clause is unconditional, its contents must be added to the body now.

(when (syntax-null? current-condition)
      (set! body #`(#,@body #,@action-clauses))
      (set! action-clauses #'()))
(set! and? #f)

((_ (do-internal (hd . tl) . rest))
 (begin
 (cond (<action-boilerplate-guard>
        (add-action-clause #'(hd . tl))
        <action-boilerplate>
        (parse-loop #'(loop-body (do-internal . rest))))
       (else
        (parse-loop #'(loop-body (end do-internal (hd . tl) . rest)))))))

When do-internal runs out of compound forms, then everything is placed into the body using the boilerplate code.

((_ (do-internal . rest))
 (parse-loop #'(loop-body  rest)))

5.2 Other Action Clauses

5.2.1 collect

The collect clause tells the loop to store a value in a collection list, which will be returned.

<collect-into>
((_ (collect value . rest))
 (cond (<action-boilerplate-guard>
        (set! initial-collection #''())
        (add-action-clause #`(set! #,collection (cons value #,collection)))
        <action-boilerplate>
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end collect value . rest))))))
((_ (collecting value . rest))
 (parse-loop #'(loop-body (collect value . rest))))

The loop macro also supports collecting into a specific variable.

(loop for x in list when (odd? x) collect into odds)

Doing this requires a separate version of the above macro. It wasn’t possible to combine the above’s functionality because there’s no way to compare syntax-objects to tell if an identifier that appears in the pattern equals collection or another macro variable.

Furthermore, because the collection variable can be accessed during iteration, and must be a list in the correct order, it is not possible to cons the list in reverse order and then reverse it, as is done with the implicit collector. Instead, adding to the end of the list is done with append, which makes collect into O(n) for each iteration where a collect into occurs. A loop that uses collect into on every iteration could be as slow as O(n2).

((_ (collect value into collector . rest))
 (cond (<action-boilerplate-guard>
        (add-action-clause #`(set! collector (append collector (list value))))
        <action-boilerplate>
        (set! let-defs #`((collector '()) . #,let-defs))
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end collect value into collector . rest))))))

5.2.2 cons

Because collect into is such a uselessly pathological case in Racket (in contrast with how useful it is in Common Lisp), an extension is provided: cons into operates like collect into, except the resulting list is seen in reverse order. There is no cons without into, and if there was, it’d be a synonym for collect.

((_ (cons value into collector . rest))
 (cond (<action-boilerplate-guard>
        (add-action-clause #`(set! collector (cons value collector)))
        <action-boilerplate>
        (set! let-defs #`((collector '()) . #,let-defs))
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end cons value into collector . rest))))))
((_ (consing . rest))
 (parse-loop #'(loop-body (cons . rest))))

5.2.3 collect variants

The collect clause can return different types. The return type is controlled by the collection-type variable, which can be set using the with-collection-type clause. When the loop is about to return, it checks the collection-type and constructs a return value as follows:

(begin
  (if #,collection
      (case #,collection-type
        ((list) (if #,reverse? (reverse #,collection)
                    #,collection))
        ((vector) (list->vector (reverse #,collection)))
        ((string) (list->string (reverse #,collection)))
        ((bytes) (list->bytes (reverse #,collection)))
        ((hash) (list->hash #,collection))
        ((hash/immutable) (list->hash/immutable #,collection)))
      #f))

That last two conversions are not provided by Racket. They must be implemented here.

(define-syntax define-list->hash
  (syntax-rules ()
    ((_ list->hash hash-return make pair set)
     (define (list->hash lst)
       (call/ec
        (λ (return)
           (loop with hash-return = (make)
                 for pair in lst
                 do set
                 finally (return hash-return))))))))
(define-list->hash list->hash hash-return make-hash pair (hash-set! hash-return (car pair) (cdr pair)))
(define-list->hash list->hash/immutable hash-return make-immutable-hash pair (set! hash-return
                                                                                   (hash-set hash-return (car pair) (cdr pair))))

((_ (with-collection-type type . rest))
 (begin
   (case (syntax->datum #'type)
     ((list) #t)
     ((vector) #t)
     ((string) #t)
     ((bytes) #t)
     ((hash) #t)
     ((hash/immutable) #t)
     (else (raise-syntax-error 'with-collection-type "Unsupported collection type" #'type)))
   (set! collection-type #`'type)
   (parse-loop #'(loop-body rest))))

5.2.4 append

This is like collect, except the value must be a list, which will be appended to the end of the collection.

((_ (append value into collector . rest))
 (cond (<action-boilerplate-guard>
        (set! prologue #`(#,@prologue (set! #,reverse? #f)))
        (add-action-clause #`(set! collector (append collector value)))
        <action-boilerplate>
        (set! let-defs #`((collector '()) . #,let-defs))
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end append value into collector . rest))))))
((_ (append value . rest))
 (cond (<action-boilerplate-guard>
        (set! initial-collection #''())
        (add-action-clause #`(set! #,collection (append #,collection value)))
        <action-boilerplate>
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end append value . rest))))))
((_ (appending . rest))
 (parse-loop #'(loop-body (append . rest))))

5.2.5 sum

This clause adds the given value to a numerical accumulator, which is then returned.

((_ (sum value into collector . rest))
 (cond (<action-boilerplate-guard>
        (add-action-clause #`(set! collector (+ collector value)))
        <action-boilerplate>
        (set! let-defs #`((collector 0) . #,let-defs))
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end sum value into collector . rest))))))
((_ (sum value . rest))
 (cond (<action-boilerplate-guard>
        (set! initial-sum #'0)
        (add-action-clause #`(set! #,sum* (+ #,sum* value)))
        <action-boilerplate>
        (parse-loop #'(loop-body rest)))
       (else
        (parse-loop #'(loop-body (end sum value . rest))))))
((_ (summing . rest))
 (parse-loop #'(loop-body sum . rest)))

5.2.6 count

Counts the number of times the expression evaluates as true. Due to a bug in Racket, it was necessary to do some syntax-object manipulation to detect when the word count is passed to the macro. This work around is the reason these syntax-case patterns say count instead.

((_ (count expression into collector . rest))
 (cond (<action-boilerplate-guard>
        (add-action-clause #`(when expression
                                   (set! collector (add1 collector))))
        <action-boilerplate>
        (set! let-defs #`((collector 0) . #,let-defs))
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end count expression into collector . rest))))))
((_ (count expression . rest))
 (cond (<action-boilerplate-guard>
        (set! initial-count #'0)
        (add-action-clause #`(when expression
                                   (set! #,count* (add1 count))))
        <action-boilerplate>
        (parse-loop #'(loop-body rest)))
       (else
        (parse-loop #'(loop-body end count expression . rest)))))
((_ (counting . rest))
 (parse-loop #'(loop-body (count . rest))))

5.2.7 minimize and maximize

This binds the smallest random number seen into min-random:

(loop repeat 100 minimizing (random 100) into min-random ...)

((_ (minimize expression into collector . rest))
 (cond (<action-boilerplate-guard>
        (add-action-clause #`(let ((temp expression))
                               (when (or (not collector)
                                         (< temp collector))
                                     (set! collector temp))))
        <action-boilerplate>
        (set! let-defs #`((collector #f) . #,let-defs))
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end count expression into collector . rest))))))
((_ (minimize expression . rest))
 (cond (<action-boilerplate-guard>
        (add-action-clause #`(let ((temp expression))
                               (when (or (not min)
                                         (< temp min))
                                     (set! min temp))))
        <action-boilerplate>
        (parse-loop #'(loop-body rest)))
       (else
        (parse-loop #'(loop-body end count expression . rest)))))
((_ (minimizing . rest))
 (parse-loop #'(loop-body (minimize . rest))))
 
((_ (maximize expression into collector . rest))
 (cond (<action-boilerplate-guard>
        (add-action-clause #`(let ((temp expression))
                               (when (or (not collector)
                                         (> temp collector))
                                     (set! collector temp))))
        <action-boilerplate>
        (set! let-defs #`((collector #f) . #,let-defs))
        (parse-loop #'(loop-body  rest)))
       (else
        (parse-loop #'(loop-body (end count expression into collector . rest))))))
((_ (maximize expression . rest))
 (cond (<action-boilerplate-guard>
        (add-action-clause #`(let ((temp expression))
                               (when (or (not max)
                                         (> temp max))
                                     (set! max temp))))
        <action-boilerplate>
        (parse-loop #'(loop-body rest)))
       (else
        (parse-loop #'(loop-body end count expression . rest)))))
((_ (maximizing . rest))
 (parse-loop #'(loop-body (maximize . rest))))

6 While and Until

(loop while keep-going ...)

(loop until stop ...)

((_ (while condition . rest))
 (begin
   (set! loop-preconditions
         #`(condition . #,loop-preconditions))
   (parse-loop #'(loop-body rest))))
((_ (until condition . rest))
 (parse-loop #'(loop-body (while (not condition) . rest))))

7 Repeating a Set Number of Times

(loop repeat 15 collect 'ocd)

(ocd ocd ocd ocd ocd ocd ocd ocd ocd ocd ocd ocd ocd ocd ocd)

((_ (repeat n . rest))
 (parse-loop #'(loop-body (for x from 1 to n . rest))))

8 Iterating over stuff

The for keyword denotes all forms of iteration:

(loop for variable preposition some-kind-of-collection ...)

In traditional Common Lisp, the preposition determines the type of some-kind-of-collection:

In Common Lisp, strings and vectors are both arrays, and Common Lisp has no equivalent to bytes.

Common Lisp also provides the on preposition, which iterates over lists, except that the variable is set to the entire remaining portion of the list instead of just the next element in the list.

In this version of the loop macro, across iterates over vectors, strings, and bytes, while in iterates over lists and hash tables, and over iterates over generators.

This version of the macro also iterates over hash-tables and generators.

All the variants of the for-clause can be captured by this syntax-case pattern:

((_ (for . rest))
 (unless (and (syntax-null? current-condition)
              (syntax-null? action-clauses)
              (syntax-null? current-cond-body))
         (raise-syntax-error 'loop "\"for\" must precede all \"if\", \"when\", \"collect\", and \"do\" clauses" stx))
 (syntax-case #'(for . rest) <loop-literals>
   <individual-for-clauses>
   (not-a-for-clause
    (parse-loop #'(loop-body not-a-for-clause)))))

The variations are all processed in a local syntax-case form.

8.1 for x in y: List and Hash Iteration

Iterating over lists is the most basic case. The list-defs let-bindings can hold a binding for the list y, which automatically results in the list being cdr’d as the loop progresses, while the iterator variable x is part of the let-defs. Finally, iterations receives code that will update x with each loop iteration.

<destructuring-for-x-in-y>
((for x in y . rest)
 (let ((y-binding (datum->syntax stx (gensym))))
   (set! iterations #`((set! x #f) (set! #,y-binding (cdr #,y-binding)). #,iterations))
   (set! preiterations #`(#,@preiterations (set! x (if (null? #,y-binding) #f
                                                       (car #,y-binding)))))
   (set! loop-preconditions #`((not (null? #,y-binding)) . #,loop-preconditions))
 
   (set! loop-conditions #`((not (null? #,y-binding)) . #,loop-conditions))
   (parse-loop #`(loop-body (with #,y-binding = y with x = (if (null? #,y-binding)
                                                               #f
                                                               (car #,y-binding)) . rest)))))

Common Lisp also supports the following:

(loop for ((a b) (c d)) in '(((1 2) (3 4)) ((5 6) (7 8))) ...)

...where the elements in the lists can be destructured according to the pattern ((a b) (c d)) to arbitrary depth. The variables can be bound using Racket’s old mzlib/match, (but not the racket/match, due to the need to throw in the word list gratuitously). For some reason, you cannot import racket/mzlib into a Scribble/LP program, due specifically to conflicts between MzLib’s match and Racket’s match. This error doesn’t occur under #lang racket. For this reason, a macro, destructuring-bind, had to be defined in a separate file. destructuring-bind is used exactly like its Common Lisp counterpart.

((for (x . rest-of-pattern) in y . rest)
 (let* ((y-binding (datum->syntax stx (gensym)))
        (variables <extract-variables-from-pattern>)
        (condition #`(not (null? #,y-binding))))
   (set! preiterations #`(#,@preiterations
                          (when #,condition
                                (set-values! #,variables
                                             (destructuring-bind (x . rest-of-pattern) (car #,y-binding)
                                                                 (values . #,variables))))))
   (set! loop-preconditions #`(#,condition . #,loop-preconditions))
   (set! loop-conditions #`((not (null? #,y-binding)) . #,loop-conditions))
   (set! list-defs #`((#,y-binding y) . #,list-defs))
   (set! let-values-defs
         #`((#,variables
             (destructuring-bind (x . rest-of-pattern) (car #,y-binding)
                                 (values . #,variables))) . #,let-values-defs))
   (parse-loop #'(loop-body rest))))

Before it becomes possible to bind variables specified in this pattern, it is necessary to flatten the pattern into a plain list of variable names. This is used both in the let-values form, and in the return value from the match pattern.

(let loop ((pat #'(x . rest-of-pattern))
           (result #'()))
    (syntax-case pat ()
      (() result)
      (((x . more-vars) . rest)
       (loop #'rest
             (loop #'(x . more-vars)
                   result)))
      ((x . rest)
       (loop #'rest
             #`(x . #,result)))))

8.2 for x on y by iterator: List iteration with entire lists.

((for x on y by iter . rest)
 (let ((y-binding (datum->syntax stx (gensym)))
       (iter-binding (datum->syntax stx (gensym))))
   (set! iterations #`((set! x #f) (set! #,y-binding (#,iter-binding #,y-binding))
                       . #,iterations))
   (set! preiterations #`(#,@preiterations (set! x #,y-binding)))
   (set! loop-preconditions #`((not (null? #,y-binding)) . #,loop-preconditions))
 
   (set! loop-conditions #`((not (null? #,y-binding)) . #,loop-conditions))
   (parse-loop #'(loop-body (with #,y-binding = y and #,iter-binding = iter with x = #,y-binding . rest)))))
((for x on y . rest)
 (parse-loop #'(loop-body (for x on y by cdr . rest))))

8.3 for x being the hash-keys in table: Hash iteration

This binds var to each of the keys in the hash-table in succession:

(loop for var being the hash-keys in hash-table ...)

You can bind the corresponding hash value to another variable like this:

(loop for var being the hash-keys in hash-table using (hash-value other-var) ...)

The reverse is also supported:

(loop for var being each hash-value in hash-table using (hash-key other-var) ...)

And the following extension is supported:

(loop for (key val) being the hash-pairs in hash-table ...)

each and the are interchangeable, as are the singular/plural forms of hash-keys, etc.

Iterating over hash tables is more difficult. Racket provides no way to get the "next" key and value pair from a hash and remove it. Instead, it provides full-iteration functions such as hash-map and hash-for-each.

A hash table can be rewritten as a list using hash->list, but that would be a bad thing to do if the hash was big.

The hash-for-each function can be used to create a generator, however, and the loop macro can iterate over generators. A generator using hash-for-each will return (void) when iteration completes, but the loop macro requires end-of-generator, because (void) is ambiguous. So the clause is rewritten as an iteration over a generator.

Since Racket’s hash iteration functions always provide both key and value, it makes sense to implement the hash-pairs extension first. The singular hash-pair can be used also, but it is simply rewritten as hash-pairs.

<for-hash-keys>
<for-hash-values>
((for (key value) being the hash-pairs in hash . rest)
 (parse-loop #`(loop-body (for (key value) over (make-hash-generator hash) . rest))))
((for (key value) being the hash-pair in hash . rest)
 (parse-loop #'(loop-body (for (key value) being the hash-pairs in hash . rest))))
((for something being each . rest)
 (parse-loop #'(loop-body (for something being the . rest))))

The generator is defined like this:

(define (make-hash-generator hash)
  (generator ()
             (begin
               (hash-for-each hash
                              (λ (k v)
                                 (yield k v)))
               (yield end-of-generator end-of-generator))))

8.3.1 for x being the hash-keys in hash using...

All of the standard Common Lisp variants for iterating over a hash table are implemented in terms of the variant above.

((for key being the hash-keys in hash using (hash-value value) . rest)
 (parse-loop #'(loop-body (for (key value) being the hash-pairs in hash . rest))))
((for key being the hash-keys in hash . rest)
 (parse-loop #'(loop-body (for (key value) being the hash-pairs in hash . rest))))
((for k being the hash-key in  hash . rest)
 (parse-loop #'(loop-body for k being the hash-keys in hash . rest)))

((for val being the hash-values in hash using (hash-key key) . rest)
 (parse-loop #'(loop-body (for (key value) being the hash-pairs in hash . rest))))
((for val being the hash-values in hash . rest)
 (parse-loop #'(loop-body (for (key value) being the hash-pairs in hash . rest))))
((for val being the hash-value . rest)
 (parse-loop #'(loop-body (for val being the hash-values . rest))))

8.4 for x over y: Generator iteration

For generator iteration, multiple values from (yield) are supported. The loop terminates when the first of these values (or the only value) is end-of-generator, whose value is defined in this file.

Example:

(loop for value over (generator ()
                              (for-each (λ (value)
                                           (yield value))
                                        '(a b c d e f g))
                              end-of-generator))

((for (x . rest-vars) over y . rest)
 (let ((y-binding (datum->syntax stx (gensym))))
   (set! let-values-defs #`(((x . rest-vars) (#,y-binding)) . #,let-values-defs))
   (set! let-defs #`((#,y-binding y) . #,let-defs))
   (let set-precondition-loop ((variables #'(x . rest-vars)))
     (syntax-case variables ()
       (() #t)
       ((x . rest-vars) (begin (set! loop-preconditions
                                #`((not (end-of-generator?  x)) . #,loop-preconditions))
                          (set-precondition-loop #'rest-vars)))))
   (parse-loop #'(loop-body rest))))
((for x over y . rest)
 (parse-loop #'(loop-body (for (x) over y . rest))))

8.5 for x across y: Vector, string, and byte iteration

((for x across y . rest)
 (let* ((y-binding (datum->syntax stx (gensym)))
        (yix (datum->syntax stx (gensym)))
        (loop-condition #`(< #,yix (alen #,y-binding))))
   (set! let-defs #`((x #f) (#,yix 0) (#,y-binding y) . #,let-defs))
   (set! preiterations #`(#,@preiterations
                          (when #,loop-condition
                                (set! x (aref #,y-binding #,yix)))))
   (set! loop-preconditions
         #`(#,loop-condition . #,loop-preconditions))
   (set! iterations
         #`((set! #,yix (add1 #,yix)) . #,iterations))
   (parse-loop #`(loop-body (with #,y-binding = y and #,yix = 0
                            with x = (if (>= #,yix (alen #,y-binding))
                                         #f
                                         (aref #,y-binding #,yix)) . rest)))))

8.6 for x = y: Iterating over numbers

<for-x=y-then>
((for x = y . rest)
 (begin
   (set! let-defs #`((x #f) . #,let-defs))
   (set! loop-preconditions
         #`((begin
              (set! x y)
              #t) . #,loop-preconditions))
   (parse-loop #'(loop-body rest))))

((for x = y then step-form . rest)
 (begin
   (set! let-defs #`((x #f) . #,let-defs))
   (set! prologue #`(#,@prologue (set! x y)))
   (set! iterations #`((set! x step-form) . #,iterations))
   (parse-loop #'(loop-body rest))))

<for-x-from-low-to-high>
((for x from low by step . rest)
 (let ((step-binding (datum->syntax stx (gensym))))
   (set! let-defs #`((#,step-binding step) . #,let-defs))
   (parse-loop #`(loop-body (for x = low then (+ x #,step-binding) . rest)))))
((for x from low . rest)
 (begin
   (parse-loop #'(loop-body (for x from low by 1 . rest)))))
((for x downfrom high . rest)
 (parse-loop #'(loop-body (for x from high by -1 . rest))))

((for x from low to high by step . rest)
 (let ((high-binding (datum->syntax stx (gensym))))
   (set! let-defs #`((#,high-binding #f) . #,let-defs))
   (set! prologue #`(#,@prologue (set! #,high-binding high)))
   (set! loop-preconditions
         #`((<= x #,high-binding) . #,loop-preconditions))
   (parse-loop #'(loop-body (for x from low by step . rest)))))
((for x from low to high . rest)
 (begin
   (parse-loop #'(loop-body (for x from low to high by 1 . rest)))))
((for x from low below high by step . rest)
 (let ((high-binding (datum->syntax stx (gensym))))
   (set! let-defs #`((#,high-binding #f) . #,let-defs))
   (set! prologue #`(#,@prologue (set! #,high-binding high)))
   (set! loop-preconditions
         #`((< x #,high-binding) . #,loop-preconditions))
   (parse-loop #'(loop-body (for x from low by step . rest)))))
((for x from low below high . rest)
 (begin
   (parse-loop #'(loop-body (for x from low below high by 1 . rest)))))
((for x from low upto high . rest)
 (begin
   (parse-loop #'(loop-body (for x from low to high . rest)))))
((for x from high downto low by step . rest)
 (let ((low-binding (datum->syntax stx (gensym))))
   (set! let-defs #`((#,low-binding #f) . #,let-defs))
   (set! prologue #`(#,@prologue (set! #,low-binding low)))
   (set! loop-preconditions
         #`((>= x #,low-binding) . #,loop-preconditions))
   (parse-loop #`(loop-body (for x = high then (- x step) . rest)))))
((for x from high downto low . rest)
 (begin
   (parse-loop #'(loop-body (for x from high downto low by 1 . rest)))))
((for x downfrom high to low . rest)
 (parse-loop #'(loop-body (for x from high downto low . rest))))
((for x from high above low by step)
 (let ((low-binding (datum->syntax stx (gensym))))
   (set! let-defs #`((#,low-binding #f) . #,let-defs))
   (set! prologue #`(#,@prologue (set! #,low-binding low)))
   (set! loop-preconditions
         #`((> x #,low-binding) . #,loop-preconditions))
   (parse-loop #`(loop-body (for x = high then (- x step) . rest)))))
((for x from  high above low . rest)
 (begin
   (parse-loop #'(loop-body (for x from high above low by 1)))))

9 WITH: Binding variables

With is used like this:

(loop with x = value ...)

It binds x to the given value by wrapping everything in a let* form. There is a variant:

(loop with x = value and y = other-value)

This variant wraps using a let form instead of let*. Of course the two variants can be mixed, producing a gnarled nest of let and let* forms over the body of the loop.

<with> ::=
((_ (with x = value and y = other-value . rest))
 (begin
   (set! current-gnarled-let-def
         #`(#,@current-gnarled-let-def (y other-value)))
   (parse-loop #'(loop-body (with* x = value . rest)))))
((_ (with* x = value and y = other-value . rest))
 (parse-loop #'(loop-body (with x = value and y = other-value . rest))))
((_ (with* x = value . rest))
 (begin
   (set! gnarled-let-defs
         #`(#,@gnarled-let-defs (#,@current-gnarled-let-def (x value))))
   (set! current-gnarled-let-def #'())
   (parse-loop #'(loop-body rest))))
((_ (with x = value . rest))
 (begin
   (set! gnarled-let-defs #`(#,@gnarled-let-defs * ((x value))))
   (parse-loop #'(loop-body rest))))

10 FINALLY

The finally clause executes at the end of iteration.

((_ (finally form . rest))
 (begin
   (set! epilogue #`(#,@epilogue form))
   (parse-loop #'(loop-body rest))))

11 INITIALLY

The initially clauses execute at the beginning of iteration, just after all variables have been initialized.

((_ (initially form . rest))
 (begin
   (set! initially-prologue #`(#,@initially-prologue form))
   (parse-loop #'(loop-body rest))))

12 always, never, and thereis

((_ (thereis form . rest))
 (let ((success? (datum->syntax stx (gensym))))
   (set! let-defs #`((#,success? #f) . #,let-defs))
   (set! body #`((when form
                       (set! #,success? #t)
                       (return #t)) . #,body))
   (parse-loop #`(loop-body (finally (return #,success?) . rest)))))
((_ (always form . rest))
 (begin
   (let ((success? (datum->syntax stx (gensym))))
     (set! let-defs #`((#,success? #t) . #,let-defs))
     (set! body #`((when (not form)
                         (set! #,success? #f)
                         (return #f)) . #,body))
     (parse-loop #`(loop-body (finally (return #,success?) . rest))))))
((_ (never form . rest))
 (parse-loop #'(loop-body (always (not form) . rest))))

(for by as being by the each hash-key hash-keys hash-value hash-values hash-pair hash-pairs from while do do-internal collect collecting repeat repeating with with* sum summing append then
     appending matching nconc nconcing cons consing count count counting string-append
     minimize minimizing maximize maximizing below above to downto downfrom upto in into on across over = until always never thereis and
     end else named initially finally if when unless return with-collection-type)

(define-syntax loop-body
  (λ (stx)
     (define call-with-cc #'call/ec)
     (define return-continuation #'loop-return)
     (define collection #'collection)
     (define initial-collection #'#f)
     (define count* #'count)
     (define initial-count #'#f)
     (define sum* #'sum)
     (define min #'min)
     (define max  #'max)
     (define reverse? #'reverse?)
     (define reverse-value #'#t)
     (define string-accumulator #'string-accumulator)
     (define initial-string #'#f)
     (define initial-sum #'#f)
     (define and? #f)
 
     (define collection-type #''list)
 
 
 
 
     (define prologue #'())
     (define initially-prologue #'())
     (define epilogue #'())
     (define iterations #'())
     (define let-values-defs #'())
     (define current-condition #'())
     (define loop-conditions #'())
     (define preiterations #'())
     (define loop-preconditions #'())
     (define action-clauses #'())
     (define current-cond-body #'())
     (define body #'())
     (define list-defs #'())
     (define let-defs #'())
     (define gnarled-let-defs #'())
     (define current-gnarled-let-def #'())
     <define-add-action-clause>
 
     (let parse-loop ((stx stx))
       (define first-word (syntax-case stx ()
                            ((_ ()) #f)
                            ((_ (first . rest))
                               (syntax->datum #'first))))
 
 
 
 
 
       (cond ((eq? first-word 'count)
              (syntax-case stx ()
                  ((_ (first . rest))
                   (parse-loop #'(loop-body (count . rest))))))
             (else
              (syntax-case stx <loop-literals>
                ((_ ())
                 (cond (<action-boilerplate-guard>
                        (let ((let-vars (get-let-vars let-defs)))
                          <loop-body>))
                       (else
                        (parse-loop #'(loop-body (end))))))
                <with>
                <initially-clause>
                <finally>
                <always/never/thereis>
                <rewrite-if-clauses>
                <collect-if-clauses>
                <collect-else-if>
                <while/until>
                <repeat>
                <and>
                <end>
                <do-clause>
                <do-internal>
                <do-internal/2>
                <collect-clause>
                <min/max>
                <cons-into>
                <with-collection-type>
                <append-clause>
                <sum-clause>
                <count-clause>
                <universal-for-clause>))))))
(provide loop-body)
 
(define-syntax loop
  (syntax-rules (named)
    ((_ named block-name . body)
     (call/ec
      (λ (block-name)
         (loop . body))))
    ((_ . body)
     (loop-body body))))
(provide loop)

((_ (for var in alist . rest))
 (unless (and (syntax-null? current-condition)
              (syntax-null? if-conditions)
              (syntax-null? current-cond-body))
         (raise-syntax-error 'loop "\"for\" must precede all \"if\", \"when\", and \"do\" clauses" stx))
 (set! iterations #`((set! var (car alist)) . #,iterations))
 (set! loop-conditions #`((not (null? alist)) . #,loop-conditions))
 (set! list-defs #`(alist . #,list-defs))
 (parse-loop #'rest))
((_ (for var across array . rest))
 (let ((iter (datum->syntax stx
                            (gensym))))
   (unless (and (syntax-null? current-condition)
                (syntax-null? if-conditions)
                (syntax-null? current-cond-body))
           (raise-syntax-error 'loop "\"for\" must precede all \"if\", \"when\", and \"do\" clauses" stx))
   (parse-loop #'rest
               finally
               #`((#,iter (add1 #,iter)) (var (aref (add1 iter) array)) . #,iterations)
               current-condition
               #`((<= #,iter (alen array)) . #,loop-conditions)
               if-conditions
               current-cond-body
               body
               list-defs
               #`((var (aref 0 array)) (#,iter 0) . #,let-defs))))
((_ (for var from start to end by step . rest)
    (unless (and (syntax-null? current-condition)
                 (syntax-null? if-conditions)
                 (syntax-null? current-cond-body))
            (raise-syntax-error 'loop "\"for\" must precede all \"if\", \"when\", and \"do\" clauses" stx))
    (parse-loop #'rest
                finally
                #`((var (+ step var)) . #,iterations)
                current-condition
                #`((<= var end) . #,loop-conditions)
                if-conditions
                current-cond-body
                body
                list-defs
                #`((var start) . #,let-defs))))
((_ (for var from start below end by step . rest)
    (unless (and (syntax-null? current-condition)
                 (syntax-null? if-conditions)
                 (syntax-null? current-cond-body))
            (raise-syntax-error 'loop "\"for\" must precede all \"if\", \"when\", and \"do\" clauses" stx))
    (parse-loop #'rest
                finally
                #`((var (+ step var)) . #,iterations)
                current-condition
                #`((< var end) . #,loop-conditions)
                if-conditions
                current-cond-body
                body
                list-defs
                #`((var start) . #,let-defs))))
((_ (for var from start to end . rest))
 (parse-loop #'(for var from start to end by 1 . rest)
             finally iterations current-condition loop-conditions if-conditions current-cond-body body list-defs let-defs))
((_ (for var from start below end . rest))
 (parse-loop #'(for var from start below end by 1 . rest)
             finally iterations current-condition loop-conditions if-conditions current-cond-body body list-defs let-defs))
((_ (for var from start by step . rest))
 (parse-loop #'rest
             finally
             #`((var (+ step var)) . #,iterations)
             current-condition
             loop-conditions
             if-conditions
             current-cond-body
             body
             list-defs
             #`((var start) . #,let-defs)))
((_ (for var from start . rest))
 (unless (and (syntax-null? current-condition)
                 (syntax-null? if-conditions)
                 (syntax-null? current-cond-body))
            (raise-syntax-error 'loop "\"for\" must precede all \"if\", \"when\", and \"do\" clauses" stx))
 (parse-loop #'(for var from start by 1 . rest) finally iterations current-condition loop-conditions if-conditions current-cond-body body list-defs let-defs))
((_ (for var = value . rest))
 (unless (and (syntax-null? current-condition)
                 (syntax-null? if-conditions)
                 (syntax-null? current-cond-body))
            (raise-syntax-error 'loop "\"for\" must precede all \"if\", \"when\", and \"do\" clauses" stx))
 (parse-loop #'rest finally iterations current-condition loop-conditions if-conditions current-cond-body body list-defs #`((var value) . #,let-defs)))

(define-syntax unwind-protect
  (syntax-rules ()
    ((_ value-form cleanup-form)
     (dynamic-wind (let ((ok? #t))
                     (lambda ()
                       (if ok?
                           (set! ok? #f)
                           (error "Re-entering UNWIND-PROTECT is prohibited."))))
         (lambda () value-form)
         (lambda () cleanup-form)))))
 
(define-syntax gnarled-let-nest
  (syntax-rules (*)
    ((_ () . body)
     (begin . body))
    ((_ (* (bindings ...) . more-bindings) . body)
     (let* (bindings ...)
       (gnarled-let-nest more-bindings . body)))
    ((_ ((bindings ...) . more-bindings) . body)
     (let (bindings ...)
       (gnarled-let-nest more-bindings . body)))
    ((_ (* (bindings ...)) . body)
     (let* (bindings ...) . body))
    ((_ ((bindings ...)) . body)
     (let (bindings ...) . body))))

(define-for-syntax (syntax-null? stx)
  (syntax-case stx ()
    (() #t)
    (_ #f)))
 
(define-for-syntax (syntax-reverse stx)
  (let loop ((rest stx)
             (result #'()))
    (syntax-case rest ()
      (() result)
      ((hd . tl) (loop #'tl #`(hd . #,result))))))
 
(define-for-syntax (get-let-vars stx)
  (let loop ((rest stx)
             (result #'()))
    (syntax-case rest ()
      (() (syntax-reverse result))
      (((var . value) . rest)
       (loop #'rest
             #`(var . #,result))))))
 
(define-for-syntax (syntax-find pred? syntax-list)
  (let loop ((rest syntax-list))
    (syntax-case rest ()
      (() #f)
      ((hd . tl)
       (if (pred? #'hd)
           #'hd
           (loop #'tl))))))
 
(define-for-syntax (add-iterations let-vars iterations)
  (let loop ((let-vars let-vars)
             (iterations iterations)
             (result #'()))
    (syntax-case let-vars ()
      (() (syntax-reverse result))
      ((var . rest)
       (let ((iter (syntax-find (λ (stx)
                                   (syntax-case stx ()
                                       ((var2 . fuckit)
                                        (eq? (syntax->datum #'var2)
                                             (syntax->datum #'var)))))
                                iterations)))
         (loop #'rest iterations (if iter (syntax-case iter ()
                                            ((var body) #`(body . #,result)))
                                     #`(var . #,result))))))))
 
 
(define (aref arr n)
  ((cond ((vector? arr) vector-ref)
         ((string? arr) string-ref)
         ((bytes? arr) bytes-ref)) arr n))
 
(define (alen arr)
  ((cond ((vector? arr) vector-length)
         ((string? arr) string-length)
         ((bytes? arr) bytes-length)) arr))
<list->hash>