diff options
author | David Thompson <dthompson2@worcester.edu> | 2023-01-24 22:09:40 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2023-06-08 08:14:41 -0400 |
commit | cf19435efad3146b578c721878db7966cb3add34 (patch) | |
tree | 4ce5c7ebaf1b19bb9617f07da943bac717ed74b6 | |
parent | 48f758b1aa275f3a64c174ac2b0c7b28643f4721 (diff) |
Add and/or.
-rw-r--r-- | chickadee/graphics/seagull.scm | 18 |
1 files changed, 18 insertions, 0 deletions
diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm index 6af69eb..b3aef24 100644 --- a/chickadee/graphics/seagull.scm +++ b/chickadee/graphics/seagull.scm @@ -301,6 +301,20 @@ ((l . rest) (loop rest `(primcall / ,exp ,(expand l stage env))))))))) +(define (expand:or exps stage env) + (match exps + (() #f) + ((exp . rest) + (expand `(let ((x ,exp)) (if x x (or ,@rest))) + stage env)))) + +(define (expand:and exps stage env) + (match exps + (() #t) + ((exp . rest) + (expand `(let ((x ,exp)) (if x (and ,@rest) #f)) + stage env)))) + (define (expand:primitive-call operator operands stage env) `(primcall ,operator ,@(expand:list operands stage env))) @@ -368,6 +382,10 @@ (expand:* args stage env)) (('/ args ...) (expand:/ args stage env)) + (('or exps ...) + (expand:or exps stage env)) + (('and exps ...) + (expand:and exps stage env)) ;; Primitive calls: (((? primitive-call-for-stage? operator) args ...) (expand:primitive-call operator args stage env)) |