444 - bring back dispatch based on operand/result types

Was dropped in commit 149. But we need it for more convenient
overloading, especially now that the right way to build tagged-values is
unclear.

The original concern was that type/otype would make code harder to
'assemble' down to native. But we should be able to insert CALL
instructions to the right clause inside a function's code. So keep it
around in the toolbox.

2 files changed, 115 insertions, 6 deletions

diff --git a/mu.arc b/mu.arc
index 79f5586b..ef813034 100644
--- a/mu.arc
+++ b/mu.arc
@@ -175,6 +175,10 @@
 
 (mac caller-args (routine)  ; assignable
   `((((rep ,routine) 'call-stack) 0) 'args))
+(mac caller-operands (routine)  ; assignable
+  `((((rep ,routine) 'call-stack) 0) 'caller-operands))
+(mac caller-results (routine)  ; assignable
+  `((((rep ,routine) 'call-stack) 0) 'caller-results))
 
 (mac results (routine)  ; assignable
   `((((rep ,routine) 'call-stack) 0) 'results))
@@ -552,6 +556,11 @@
                         (if (len> caller-args.routine* idx)
                           (list caller-args.routine*.idx t)
                           (list nil nil))))
+                ; type and otype won't always easily compile. be careful.
+                type
+                  (ty (caller-operands.routine* (v arg.0)))
+                otype
+                  (ty (caller-results.routine* (v arg.0)))
                 prepare-reply
                   (prepare-reply arg)
                 reply
@@ -574,11 +583,19 @@
                         (continue)))
                 ; else try to call as a user-defined function
                   (do (if function*.op
-                        (let callee-args (accum yield
-                                           (each a arg
-                                             (yield (m a))))
+                        (with (callee-args (accum yield
+                                             (each a arg
+                                               (yield (m a))))
+                               callee-operands (accum yield
+                                                 (each a arg
+                                                   (yield a)))
+                               callee-results (accum yield
+                                                (each a oarg
+                                                  (yield a))))
                           (push-stack routine* op)
-                          (= caller-args.routine* callee-args))
+                          (= caller-args.routine* callee-args)
+                          (= caller-operands.routine* callee-operands)
+                          (= caller-results.routine* callee-results))
                         (err "no such op @op"))
                       (continue))
                 )
diff --git a/mu.arc.t b/mu.arc.t
index 2788e9c0..0658710d 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -2025,8 +2025,6 @@
   (prn "F - an example function that checks that its oarg is an integer"))
 ;? (quit)
 
-; todo - test that reply increments pc for caller frame after popping current frame
-
 (reset)
 (new-trace "dispatch-multiple-clauses")
 ;? (set dump-trace*)
@@ -2107,6 +2105,100 @@
 (if (~and (is memory*.3 t) (is memory*.12 37))
   (prn "F - different calls can exercise different clauses of the same function"))
 
+; We can also dispatch based on the type of the operands or results at the
+; caller.
+
+(reset)
+(new-trace "dispatch-otype")
+(add-code
+  '((function test1 [
+      (4:type <- otype 0:offset)
+      { begin
+        (5:boolean <- equal 4:type integer:literal)
+        (break-unless 5:boolean)
+        (6:integer <- next-input)
+        (7:integer <- next-input)
+        (8:integer <- add 6:integer 7:integer)
+      }
+      (reply 8:integer)
+     ])
+    (function main [
+      (1:integer <- test1 1:literal 3:literal)
+     ])))
+(run 'main)
+;? (prn memory*)
+(if (~iso memory*.1 4)
+  (prn "F - an example function that checks that its oarg is an integer"))
+;? (quit)
+
+; todo - test that reply increments pc for caller frame after popping current frame
+
+(reset)
+(new-trace "dispatch-otype-multiple-clauses")
+;? (set dump-trace*)
+(add-code
+  '((function test1 [
+      (4:type <- otype 0:offset)
+      { begin
+        ; integer needed? add args
+        (5:boolean <- equal 4:type integer:literal)
+        (break-unless 5:boolean)
+        (6:integer <- next-input)
+        (7:integer <- next-input)
+        (8:integer <- add 6:integer 7:integer)
+        (reply 8:integer)
+      }
+      { begin
+        ; boolean needed? 'or' args
+        (5:boolean <- equal 4:type boolean:literal)
+        (break-unless 5:boolean 4:offset)
+        (6:boolean <- next-input)
+        (7:boolean <- next-input)
+        (8:boolean <- or 6:boolean 7:boolean)
+        (reply 8:boolean)
+      }])
+    (function main [
+      (1:boolean <- test1 t:literal t:literal)
+     ])))
+;? (each stmt function*!test1
+;?   (prn "  " stmt))
+(run 'main)
+;? (wipe dump-trace*)
+;? (prn memory*)
+(if (~is memory*.1 t)
+  (prn "F - an example function that can do different things (dispatch) based on the type of its args or oargs"))
+;? (quit)
+
+(reset)
+(new-trace "dispatch-otype-multiple-calls")
+(add-code
+  '((function test1 [
+      (4:type <- otype 0:offset)
+      { begin
+        (5:boolean <- equal 4:type integer:literal)
+        (break-unless 5:boolean)
+        (6:integer <- next-input)
+        (7:integer <- next-input)
+        (8:integer <- add 6:integer 7:integer)
+        (reply 8:integer)
+      }
+      { begin
+        (5:boolean <- equal 4:type boolean:literal)
+        (break-unless 5:boolean)
+        (6:boolean <- next-input)
+        (7:boolean <- next-input)
+        (8:boolean <- or 6:boolean 7:boolean)
+        (reply 8:boolean)
+      }])
+    (function main [
+      (1:boolean <- test1 t:literal t:literal)
+      (2:integer <- test1 3:literal 4:literal)
+     ])))
+(run 'main)
+;? (prn memory*)
+(if (~and (is memory*.1 t) (is memory*.2 7))
+  (prn "F - different calls can exercise different clauses of the same function"))
+
 )  ; section 100
 
 (section 20