summaryrefslogtreecommitdiff
path: root/src/scheme/ao_scheme_do.scheme
diff options
context:
space:
mode:
authorKeith Packard <keithp@keithp.com>2018-01-06 17:29:10 -0800
committerKeith Packard <keithp@keithp.com>2018-01-06 17:31:43 -0800
commit16061947d4376b41e596d87f97ec53ec29d17644 (patch)
treef7ad08f8810b0ea78cf282048eacb46d441a2ee1 /src/scheme/ao_scheme_do.scheme
parent39df849f0717d92a7d5bdf8aa5904bd4db1b467f (diff)
altos/scheme: Add ports. Split scheme code up.
And lots of other changes, including freeing unreferenced atoms. Signed-off-by: Keith Packard <keithp@keithp.com>
Diffstat (limited to 'src/scheme/ao_scheme_do.scheme')
-rw-r--r--src/scheme/ao_scheme_do.scheme34
1 files changed, 34 insertions, 0 deletions
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))