X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_do.scheme;fp=src%2Fscheme%2Fao_scheme_do.scheme;h=063e4a38b53702419cb162a2420d2e53f074f291;hb=16061947d4376b41e596d87f97ec53ec29d17644;hp=0000000000000000000000000000000000000000;hpb=39df849f0717d92a7d5bdf8aa5904bd4db1b467f;p=fw%2Faltos

diff --git a/src/scheme/ao_scheme_do.scheme b/src/scheme/ao_scheme_do.scheme
new file mode 100644
index 00000000..063e4a38
--- /dev/null
+++ b/src/scheme/ao_scheme_do.scheme
@@ -0,0 +1,34 @@
+(define do
+  (macro (vars test . cmds)
+    (define (_step v)
+      (if (null? v)
+	  '()
+	  (if (null? (cddr (car v)))
+	      (_step (cdr v))
+	      (cons `(set! ,(caar v) ,(caddr (car v)))
+		    (_step (cdr v))
+		    )
+	      )
+	  )
+      )
+    `(let ,(map (lambda (v) (list (car v) (cadr v))) vars)
+       (while (not ,(car test))
+	      ,@cmds
+	      ,@(_step vars)
+	      )
+       ,@(cdr test)
+       )
+    )
+  )
+
+(do ((x 1 (+ x 1)))
+    ((= x 10) "done")
+  (display "x: ")
+  (write x)
+  (newline)
+  )
+
+(do ((vec (make-vector 5))
+     (i 0 (+ i 1)))
+    ((= i 5) vec)
+  (vector-set! vec i i))