diff options
| -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)) |