diff options
author | David Thompson <dthompson2@worcester.edu> | 2023-01-14 12:42:30 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2023-06-08 08:14:41 -0400 |
commit | 7222f641750ef55b5c44341347e56044c3cf5e85 (patch) | |
tree | 82a9b908d83b313ed62a8939f7e7f9a891ba0674 | |
parent | 1161556e4feab4b845f30eb81a90d8a2461f5347 (diff) |
Allow - and / to be n-ary.
-rw-r--r-- | chickadee/graphics/seagull.scm | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm index 50ac1e8..f7dd555 100644 --- a/chickadee/graphics/seagull.scm +++ b/chickadee/graphics/seagull.scm @@ -215,6 +215,10 @@ (define params* (lookup-all params env*)) `(lambda ,params* ,(expand body env*))) +;; Arithmetic operators, in true Lisp fashion, can accept many +;; arguments. + and * accept 0 or more. - and / accept one or more. +;; The expansion pass transforms all such expressions into binary +;; operator form. (define (expand:+ args env) (match args (() 0) @@ -222,6 +226,14 @@ ((n . rest) `(primcall + ,(expand n env) ,(expand:+ rest env))))) +(define (expand:- args env) + (match args + ((n) `(primcall - ,(expand n env) 0)) + ((m n) + `(primcall - ,(expand m env) ,(expand n env))) + ((n . rest) + `(primcall - ,(expand n env) ,(expand:- rest env))))) + (define (expand:* args env) (match args (() 1) @@ -229,6 +241,21 @@ ((n . rest) `(primcall * ,(expand n env) ,(expand:* rest env))))) +(define (expand:/ args env) + (match args + ((n) + `(primcall / 1 ,(expand n env))) + ((m n) + `(primcall / ,(expand m env) ,(expand n env))) + ((m n . rest) + (let loop ((rest rest) + (exp `(primcall / ,(expand m env) ,(expand n env)))) + (match rest + ((l) + `(primcall / ,exp ,(expand l env))) + ((l . rest) + (loop rest `(primcall / ,exp ,(expand l env))))))))) + (define (expand:primitive-call operator operands env) `(primcall ,operator ,@(expand:list operands env))) @@ -264,8 +291,12 @@ (expand:let* bindings body env)) (('+ args ...) (expand:+ args env)) + (('- args ...) + (expand:- args env)) (('* args ...) (expand:* args env)) + (('/ args ...) + (expand:/ args env)) ;; Primitive calls: (((? primitive-call? operator) args ...) (expand:primitive-call operator args env)) |