git.gag.com Git - fw/altos/blob - src/scheme/ao_scheme_do.scheme

   1 (define do
   2   (macro (vars test . cmds)
   3     (define (_step v)
   4       (if (null? v)
   5           '()
   6           (if (null? (cddr (car v)))
   7               (_step (cdr v))
   8               (cons `(set! ,(caar v) ,(caddr (car v)))
   9                     (_step (cdr v))
  10                     )
  11               )
  12           )
  13       )
  14     `(let ,(map (lambda (v) (list (car v) (cadr v))) vars)
  15        (while (not ,(car test))
  16               ,@cmds
  17               ,@(_step vars)
  18               )
  19        ,@(cdr test)
  20        )
  21     )
  22   )
  23
  24 (do ((x 1 (+ x 1)))
  25     ((= x 10) "done")
  26   (display "x: ")
  27   (write x)
  28   (newline)
  29   )
  30
  31 (do ((vec (make-vector 5))
  32      (i 0 (+ i 1)))
  33     ((= i 5) vec)
  34   (vector-set! vec i i))