352 - 'interpolate' as a poor man's printf

2 files changed, 174 insertions, 2 deletions

diff --git a/mu.arc b/mu.arc
index 4a5429aa..d2486df7 100644
--- a/mu.arc
+++ b/mu.arc
@@ -1148,6 +1148,79 @@
   }
   (reply (result string-address)))
 
+; replace underscores in first with remaining args
+(init-fn interpolate  ; string-address template, string-address a
+  ((default-scope scope-address) <- new (scope literal) (30 literal))
+  ; result-len = template.length + a.length - 1 (we'll the '_')
+  ((template string-address) <- arg)
+  ((tem-len integer) <- len (template string-address deref))
+  ((a string-address) <- arg)
+  ((a-len integer) <- len (a string-address deref))
+  ((result-len integer) <- add (tem-len integer) (a-len integer))
+  ((result-len integer) <- sub (result-len integer) (1 literal))
+  ; result = new string[result-len]
+  ((result string-address) <- new (string literal) (result-len integer))
+  ; result-idx = i = 0
+  ((result-idx integer) <- copy (0 literal))
+  ((i integer) <- copy (0 literal))
+  { begin
+    ; copy template into result until '_'
+    { begin
+      ; while (i < template.length)
+      ((tem-done? boolean) <- lt (i integer) (tem-len integer))
+      (break-unless (tem-done? boolean) (2 blocks))
+      ; while template[i] != '_'
+      ((in byte) <- index (template string-address deref) (i integer))
+      ((underscore? boolean) <- eq (in byte) (#\_ literal))
+      (break-if (underscore? boolean))
+      ; result[result-idx] = template[i]
+      ((out byte-address) <- index-address (result string-address deref) (result-idx integer))
+      ((out byte-address deref) <- copy (in byte))
+      ; ++i
+      ((i integer) <- add (i integer) (1 literal))
+      ; ++result-idx
+      ((result-idx integer) <- add (result-idx integer) (1 literal))
+      (loop)
+    }
+;?     (print-primitive ("i now: " literal))
+;?     (print-primitive (i integer))
+;?     (print-primitive ("\n" literal))
+    ; copy 'a' into result
+    ((j integer) <- copy (0 literal))
+    { begin
+      ; while (j < a.length)
+      ((arg-done? boolean) <- lt (j integer) (a-len integer))
+      (break-unless (arg-done? boolean))
+      ; result[result-idx] = a[j]
+      ((in byte) <- index (a string-address deref) (j integer))
+      ((out byte-address) <- index-address (result string-address deref) (result-idx integer))
+      ((out byte-address deref) <- copy (in byte))
+      ; ++j
+      ((j integer) <- add (j integer) (1 literal))
+      ; ++result-idx
+      ((result-idx integer) <- add (result-idx integer) (1 literal))
+      (loop)
+    }
+    ; skip '_' in template
+    ((i integer) <- add (i integer) (1 literal))
+    ; copy rest of template into result
+    { begin
+      ; while (i < template.length)
+      ((tem-done? boolean) <- lt (i integer) (tem-len integer))
+      (break-unless (tem-done? boolean))
+      ; result[result-idx] = template[i]
+      ((in byte) <- index (template string-address deref) (i integer))
+      ((out byte-address) <- index-address (result string-address deref) (result-idx integer))
+      ((out byte-address deref) <- copy (in byte))
+      ; ++i
+      ((i integer) <- add (i integer) (1 literal))
+      ; ++result-idx
+      ((result-idx integer) <- add (result-idx integer) (1 literal))
+      (loop)
+    }
+  }
+  (reply (result string-address)))
+
 (def canon (table)
   (sort (compare < [tostring (prn:car _)]) (as cons table)))
 
diff --git a/mu.arc.t b/mu.arc.t
index 98e67933..65406d13 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -3032,10 +3032,12 @@
 
 ; helper
 (def memory-contains (addr value)
-  (and (is memory*.addr len.value)
+;?   (prn "Looking for @value starting at @addr")
+  (and (>= memory*.addr len.value)
        (loop (addr (+ addr 1)
               idx  0)
-         (if (> addr len.value)
+;? ;?          (prn "comparing @memory*.addr and @value.idx")
+         (if (>= idx len.value)
                t
              (~is memory*.addr value.idx)
                (do1 nil
@@ -3058,4 +3060,101 @@
 (if (~memory-contains memory*.3 "hello, world!")
   (prn "F - 'strcat' concatenates strings"))
 
+(reset)
+(new-trace "interpolate")
+(add-code '((def main [
+              ((1 string-address) <- new "hello, _!")
+              ((2 string-address) <- new "abc")
+              ((3 string-address) <- interpolate (1 string-address) (2 string-address))
+             ])))
+;? (= dump-trace* (obj whitelist '("run")))
+(run 'main)
+;? (prn memory*.1 " " memory*.2 " " memory*.3)
+;? (prn (memory* memory*.3))
+;? (prn (memory* (+ memory*.3 1)))
+;? (prn (memory* (+ memory*.3 2)))
+;? (prn (memory* (+ memory*.3 3)))
+;? (prn (memory* (+ memory*.3 4)))
+;? (prn (memory* (+ memory*.3 5)))
+;? (prn (memory* (+ memory*.3 6)))
+;? (prn (memory* (+ memory*.3 7)))
+;? (prn (memory* (+ memory*.3 8)))
+;? (prn (memory* (+ memory*.3 9)))
+;? (prn (memory* (+ memory*.3 10)))
+;? (prn (memory* (+ memory*.3 11)))
+(if (~memory-contains memory*.3 "hello, abc!")
+  (prn "F - 'interpolate' splices strings"))
+
+(reset)
+(new-trace "interpolate-empty")
+(add-code '((def main [
+              ((1 string-address) <- new "hello!")
+              ((2 string-address) <- new "abc")
+              ((3 string-address) <- interpolate (1 string-address) (2 string-address))
+             ])))
+;? (= dump-trace* (obj whitelist '("run")))
+(run 'main)
+;? (prn (memory* memory*.3))
+;? (prn (memory* (+ memory*.3 1)))
+;? (prn (memory* (+ memory*.3 2)))
+;? (prn (memory* (+ memory*.3 3)))
+;? (prn (memory* (+ memory*.3 4)))
+;? (prn (memory* (+ memory*.3 5)))
+;? (prn (memory* (+ memory*.3 6)))
+;? (prn (memory* (+ memory*.3 7)))
+;? (prn (memory* (+ memory*.3 8)))
+;? (prn (memory* (+ memory*.3 9)))
+;? (prn (memory* (+ memory*.3 10)))
+;? (prn (memory* (+ memory*.3 11)))
+(if (~memory-contains memory*.3 "hello!")
+  (prn "F - 'interpolate' without underscore returns template"))
+
+(reset)
+(new-trace "interpolate-at-start")
+(add-code '((def main [
+              ((1 string-address) <- new "_, hello!")
+              ((2 string-address) <- new "abc")
+              ((3 string-address) <- interpolate (1 string-address) (2 string-address))
+             ])))
+;? (= dump-trace* (obj whitelist '("run")))
+(run 'main)
+;? (prn (memory* memory*.3))
+;? (prn (memory* (+ memory*.3 1)))
+;? (prn (memory* (+ memory*.3 2)))
+;? (prn (memory* (+ memory*.3 3)))
+;? (prn (memory* (+ memory*.3 4)))
+;? (prn (memory* (+ memory*.3 5)))
+;? (prn (memory* (+ memory*.3 6)))
+;? (prn (memory* (+ memory*.3 7)))
+;? (prn (memory* (+ memory*.3 8)))
+;? (prn (memory* (+ memory*.3 9)))
+;? (prn (memory* (+ memory*.3 10)))
+;? (prn (memory* (+ memory*.3 11)))
+(if (~memory-contains memory*.3 "abc, hello")
+  (prn "F - 'interpolate' splices strings at start"))
+
+(reset)
+(new-trace "interpolate-at-end")
+(add-code '((def main [
+              ((1 string-address) <- new "hello, _")
+              ((2 string-address) <- new "abc")
+              ((3 string-address) <- interpolate (1 string-address) (2 string-address))
+             ])))
+;? (= dump-trace* (obj whitelist '("run")))
+(run 'main)
+;? (prn (memory* memory*.3))
+;? (prn (memory* (+ memory*.3 1)))
+;? (prn (memory* (+ memory*.3 2)))
+;? (prn (memory* (+ memory*.3 3)))
+;? (prn (memory* (+ memory*.3 4)))
+;? (prn (memory* (+ memory*.3 5)))
+;? (prn (memory* (+ memory*.3 6)))
+;? (prn (memory* (+ memory*.3 7)))
+;? (prn (memory* (+ memory*.3 8)))
+;? (prn (memory* (+ memory*.3 9)))
+;? (prn (memory* (+ memory*.3 10)))
+;? (prn (memory* (+ memory*.3 11)))
+(if (~memory-contains memory*.3 "hello, abc")
+  (prn "F - 'interpolate' splices strings at start"))
+
 (reset)  ; end file with this to persist the trace for the final test