summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-01-24 22:09:40 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-06-08 08:14:41 -0400
commitcf19435efad3146b578c721878db7966cb3add34 (patch)
tree4ce5c7ebaf1b19bb9617f07da943bac717ed74b6
parent48f758b1aa275f3a64c174ac2b0c7b28643f4721 (diff)
Add and/or.
-rw-r--r--chickadee/graphics/seagull.scm18
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))