From 368e76cdf685e589f807755bdd39a31e8ccd2c83 Mon Sep 17 00:00:00 2001
From: "Kartik K. Agaram" <vc@akkartik.com>
Date: Fri, 11 Jul 2014 22:26:19 -0700
Subject: 19 - example function with type-based dispatch

I imagined we could just push new clauses at the top, but that isn't realistic;
it would mess up all the jump locations.
Either we need to append clauses, or we need some sort of relative adddressing
for locations. Can't think of a third idea at the moment.
Appending clauses is fine as long as functions are restrictive about what they
accept.
---
 mu.arc   | 15 ++++++++++++---
 mu.arc.t | 32 +++++++++++++++++++++++++++++---
 2 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/mu.arc b/mu.arc
index 67225100..765ccf4b 100644
--- a/mu.arc
+++ b/mu.arc
@@ -9,6 +9,9 @@
   (= function* (table)))
 (clear)
 
+; just a convenience until we get an assembler
+(= type* (obj integer 0 location 1 address 2))
+
 (mac aelse (test else . body)
   `(aif ,test
       (do ,@body)
@@ -37,8 +40,10 @@
               loadi
                 (= (memory* oarg.0.1) arg.0)
               add
+;?               (do (prn "add " arg.0.1 arg.1.1)
                 (= (memory* oarg.0.1)
                    (+ (memory* arg.0.1) (memory* arg.1.1)))
+;?                 (prn "add2"))
               sub
                 (= (memory* oarg.0.1)
                    (- (memory* arg.0.1) (memory* arg.1.1)))
@@ -60,13 +65,17 @@
                               ++.fn-arg-idx))
                   (= (memory* oarg.0.1)
                      (memory* fn-args.idx.1)))
+              otype
+                (= (memory* oarg.0.1)
+                   (type* (otypes arg.0)))
               jmp
-                (do (= pc arg.0.1)
+                (do (= pc (- arg.0.1 1))  ; because continue still increments (bug)
 ;?                     (prn "jumping to " pc)
                     (continue))
               jifz
                 (when (is 0 (memory* arg.0.1))
-                  (= pc arg.1.1)
+;?                   (prn "jumping to " arg.1.1)
+                  (= pc (- arg.1.1 1))  ; because continue still increments (bug)
                   (continue))
               reply
                 (do (= result arg)
@@ -74,7 +83,7 @@
               ; else user-defined function
                 (aelse function*.op (prn "no definition for " op)
 ;?                   (prn "== " memory*)
-                  (let results (run it arg)
+                  (let results (run it arg (map car oarg))
                     (each o oarg
 ;?                       (prn o)
                       (= (memory* o.1) (memory* pop.results.1)))))
diff --git a/mu.arc.t b/mu.arc.t
index 5bca40b5..d35bddf0 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -180,7 +180,8 @@
       ((integer 1) <- loadi 8)
       (jmp (location 3))
       ((integer 2) <- loadi 3)
-      (reply))))
+      (reply)
+      ((integer 3) <- loadi 34))))
 (run function*!main)
 ;? (prn memory*)
 (if (~iso memory* (obj 1 8))
@@ -192,7 +193,8 @@
       ((integer 1) <- loadi 0)
       (jifz (integer 1) (location 3))
       ((integer 2) <- loadi 3)
-      (reply))))
+      (reply)
+      ((integer 3) <- loadi 34))))
 (run function*!main)
 ;? (prn memory*)
 (if (~iso memory* (obj 1 0))
@@ -204,8 +206,32 @@
       ((integer 1) <- loadi 1)
       (jifz (integer 1) (location 3))
       ((integer 2) <- loadi 3)
-      (reply))))
+      (reply)
+      ((integer 3) <- loadi 34))))
 (run function*!main)
 ;? (prn memory*)
 (if (~iso memory* (obj 1 1  2 3))
   (prn "F - jifz works - 2"))
+
+(clear)
+(add-fns
+  '((add-fn
+      ((integer 4) <- otype 0)
+      ((integer 5) <- loadi 0)  ; type index corresponding to 'integer'
+      ((integer 6) <- sub (integer 4) (integer 5))
+      (jifz (integer 6) (location 5))
+      (reply)
+      ((integer 7) <- arg)
+      ((integer 8) <- arg)
+      ((integer 9) <- add (integer 7) (integer 8))
+      (reply (integer 9)))
+    (main
+      ((integer 1) <- loadi 1)
+      ((integer 2) <- loadi 3)
+      ((integer 3) <- add-fn (integer 1) (integer 2)))))
+(run function*!main)
+;? (prn memory*)
+(if (~iso memory* (obj 1 1  2 3                     3 4
+                         ; add-fn's temporaries
+                         4 0  5 0  6 0  7 1  8 3  9 4))
+  (prn "F - user-defined function with clauses"))
-- 
cgit 1.4.1-2-gfad0