From 172407fef139379f0016873b0c8b1f8f3ec70f4a Mon Sep 17 00:00:00 2001
From: sforman <sforman@hushmail.com>
Date: Fri, 11 Aug 2023 21:15:26 -0700
Subject: [PATCH] branch and refactor simple functions.

The refactor should be a macro but I don't know how to write those yet
(apparently there are different macros systems...  ooo la la!)
---
 implementations/scheme-chicken/joy.scm | 30 +++++++++++++++++++-------
 1 file changed, 22 insertions(+), 8 deletions(-)

diff --git a/implementations/scheme-chicken/joy.scm b/implementations/scheme-chicken/joy.scm
index a9bdbf2..85b5402 100644
--- a/implementations/scheme-chicken/joy.scm
+++ b/implementations/scheme-chicken/joy.scm
@@ -45,24 +45,30 @@
 (define (joy-eval symbol stack expression dict)
   (define (is-it? name) (string=? symbol name))
   (cond
-    ((is-it? "+") (values (joy-add stack) expression dict))
-    ((is-it? "-") (values (joy-sub stack) expression dict))
-    ((is-it? "*") (values (joy-mul stack) expression dict))
-    ((is-it? "mul") (values (joy-mul stack) expression dict))
+    ((is-it? "+") ((joy-func +) stack expression dict))
+    ((is-it? "-") ((joy-func -) stack expression dict))
+    ((is-it? "*") ((joy-func *) stack expression dict))
+    ((is-it? "mul") ((joy-func *) stack expression dict))
+
     ((is-it? "dup") (values (cons (car stack) stack) expression dict))
     ((is-it? "pop") (values (cdr stack) expression dict))
     ((is-it? "stack") (values (cons stack stack) expression dict))
     ((is-it? "swaack") (values (cons (cdr stack) (car stack)) expression dict))
     ((is-it? "swap") (values (cons (cadr stack) (cons (car stack) (cddr stack))) expression dict))
+
     ((is-it? "i") (joy-i stack expression dict))
     ((is-it? "dip") (joy-dip stack expression dict))
+    ((is-it? "branch") (joy-branch stack expression dict))
+
     ((hash-table-exists? dict symbol)
       (values stack (append (hash-table-ref dict symbol) expression) dict))
+
     (else (error "Unknown word."))))
 
-(define (joy-add stack) (cons (+ (cadr stack) (car stack)) (cddr stack)))
-(define (joy-sub stack) (cons (- (cadr stack) (car stack)) (cddr stack)))
-(define (joy-mul stack) (cons (* (cadr stack) (car stack)) (cddr stack)))
+(define (joy-func op)
+  (lambda (stack expression dict)
+    (values (cons (op (cadr stack) (car stack)) (cddr stack)) expression dict)))
+
 
 (define (joy-i stack expression dict)
   (values (cdr stack) (append (car stack) expression) dict))
@@ -72,6 +78,14 @@
           (append (car stack) (cons (cadr stack) expression))
           dict))
 
+(define (joy-branch stack expression dict)
+  (let ((flag (caddr stack))
+        (false_body (cadr stack))
+        (true_body (car stack)))
+    (values (cdddr stack)
+            (append (if flag true_body false_body) expression)
+            dict)))
+
 
 (define (string-replace str from to)
   (string-intersperse (string-split str from #t) to))
@@ -145,6 +159,6 @@
     (hash-table-set! dict (car def_list) (cdr def_list))))
 
 
-(display (doit "1 2 3 [4 5 6] dip"))
+(display (doit "true [4] [5] branch false  [4] [5] branch + sqr"))
 (newline)