From 7222f641750ef55b5c44341347e56044c3cf5e85 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 14 Jan 2023 12:42:30 -0500
Subject: Allow - and / to be n-ary.

---
 chickadee/graphics/seagull.scm | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

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))
-- 
cgit v1.2.3