744 - test cursor movement in trace browser

Don't prevent run-code from clobbering existing functions, but warn
because it makes traces easier to read if the different sections of a
test can be distinguished.

3 files changed, 211 insertions, 4 deletions

diff --git a/mu.arc b/mu.arc
index c5a14eca..2182daf5 100644
--- a/mu.arc
+++ b/mu.arc
@@ -321,6 +321,7 @@
 
 (def run fn-names
   (freeze function*)
+;?   (prn function*!main) ;? 1
   (load-system-functions)
   (apply run-more fn-names))
 
@@ -1651,18 +1652,30 @@
           (recur (+ addr 1) (+ idx 1)))))
 
 (def memory-contains-array (addr value)
-;?   (prn "Looking for @value starting at @addr, size @memory*.addr vs @len.value")
+  (or
+    (and (>= memory*.addr len.value)
+         (loop (addr (+ addr 1)
+                idx  0)
+           (if (>= idx len.value)
+                 t
+               (~is memory*.addr value.idx)
+                 nil
+               :else
+                 (recur (+ addr 1) (+ idx 1)))))
+    (memory-contains-array-verbose addr value)))
+
+(def memory-contains-array-verbose (addr value)
+  (prn "Mismatch when looking at @addr, size @memory*.addr vs @len.value")
   (and (>= memory*.addr len.value)
        (loop (addr (+ addr 1)
               idx  0)
-;?          (and (< idx len.value) (prn "comparing @idx: @memory*.addr and @value.idx")) ;? 2
+         (and (< idx len.value) (prn "comparing @idx: @memory*.addr and @value.idx"))
          (if (>= idx len.value)
                t
              (~is memory*.addr value.idx)
                (do1 nil
                     (prn "@addr should contain @(repr value.idx) but contains @(repr memory*.addr)")
-;?                     (recur (+ addr 1) (+ idx 1)) ;? 5
-                    )
+                    (recur (+ addr 1) (+ idx 1)))
              :else
                (recur (+ addr 1) (+ idx 1))))))
 
@@ -1670,6 +1683,9 @@
 (mac run-code (name . body)
   ; careful to avoid re-processing functions and adding noise to traces
   `(do
+     (when (function* ',name)
+       (prn "run-code: redefining " ',name))
+     (wipe (function* ',name))
      (add-code '((function ,name [ ,@body ])))
      (freeze-another ',name)
      (run-more ',name)))
@@ -2629,6 +2645,47 @@
   (cursor-up-on-host)
 )
 
+(init-fn cursor-left
+  (default-space:space-address <- new space:literal 30:literal)
+  (x:terminal-address <- next-input)
+  { begin
+    (break-unless x:terminal-address)
+    (col:integer-address <- get-address x:terminal-address/deref cursor-col:offset)
+    { begin
+      (edge?:boolean <- lesser-or-equal col:integer-address/deref 0:literal)
+      (break-if edge?:boolean)
+      (col:integer-address/deref <- subtract col:integer-address/deref 1:literal)
+    }
+    (reply)
+  }
+  (cursor-left-on-host)
+)
+
+(init-fn cursor-right
+  (default-space:space-address <- new space:literal 30:literal)
+  (x:terminal-address <- next-input)
+  (width:integer-address <- get-address x:terminal-address/deref num-cols:offset)
+  { begin
+    (break-unless x:terminal-address)
+    (col:integer-address <- get-address x:terminal-address/deref cursor-col:offset)
+    { begin
+      (edge?:boolean <- lesser-or-equal col:integer-address/deref width:integer-address/deref)
+      (break-if edge?:boolean)
+      (col:integer-address/deref <- add col:integer-address/deref 1:literal)
+    }
+    (reply)
+  }
+  (cursor-right-on-host)
+)
+
+(init-fn replace-character
+  (default-space:space-address <- new space:literal 30:literal)
+  (x:terminal-address <- next-input)
+  (c:character <- next-input)
+  (print-character x:terminal-address c:character)
+  (cursor-left x:terminal-address)
+)
+
 (init-fn print-character
   (default-space:space-address <- new space:literal 30:literal)
   (x:terminal-address <- next-input)
diff --git a/trace.arc.t b/trace.arc.t
index 17b3ff32..dbf2277f 100644
--- a/trace.arc.t
+++ b/trace.arc.t
@@ -106,3 +106,152 @@ schedule:  done with routine")
   (prn "F - print-traces-collapsed leaves cursor at next line"))
 
 (reset)
+(new-trace "process-key-move-up-down")
+(add-code:readfile "trace.mu")
+(add-code
+  '((function! main [
+      (default-space:space-address <- new space:literal 30:literal/capacity)
+      (x:string-address <- new
+"schedule: main
+run: main 0: (((1 integer)) <- ((copy)) ((1 literal)))
+run: main 0: 1 => ((1 integer))
+mem: ((1 integer)): 1 <= 1
+run: main 1: (((2 integer)) <- ((copy)) ((3 literal)))
+run: main 1: 3 => ((2 integer))
+mem: ((2 integer)): 2 <= 3
+run: main 2: (((3 integer)) <- ((add)) ((1 integer)) ((2 integer)))
+mem: ((1 integer)) => 1
+mem: ((2 integer)) => 3
+run: main 2: 4 => ((3 integer))
+mem: ((3 integer)): 3 <= 4
+schedule:  done with routine")
+      (s:stream-address <- init-stream x:string-address)
+      (1:instruction-trace-address-array-address/raw <- parse-traces s:stream-address)
+      (len:integer <- length 1:instruction-trace-address-array-address/raw/deref)
+      (2:terminal-address/raw <- init-fake-terminal 70:literal 15:literal)
+      ; position the cursor away from top of screen
+      (cursor-down 2:terminal-address/raw)
+      (cursor-down 2:terminal-address/raw)
+      (3:space-address/raw <- screen-state)
+      ; draw trace
+      (print-traces-collapsed 3:space-address/raw/screen-state 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+      ; move cursor up
+      ; we have no way yet to test special keys like up-arrow
+      (s:string-address <- new "k")
+      (k:keyboard-address <- init-keyboard s:string-address)
+      (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+      ; draw cursor
+      (replace-character 2:terminal-address/raw ((#\* literal)))
+      (4:string-address/raw <- get 2:terminal-address/raw/deref data:offset)
+    ])))
+(run 'main)
+(each routine completed-routines*
+  (awhen rep.routine!error
+    (prn "error - " it)))
+(when (~memory-contains-array memory*.4
+         (+ "                                                                      "
+            "                                                                      "
+            "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal)))                 "
+            "+ main/ 0 : 1 => ((1 integer))                                        "
+            "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal)))                 "
+            "+ main/ 1 : 3 => ((2 integer))                                        "
+            "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer)))    "
+            "* main/ 2 : 4 => ((3 integer))                                        "))
+            ;^cursor
+  (prn "F - process-key can move up"))
+(run-code main2
+  (default-space:space-address <- new space:literal 30:literal/capacity)
+  ; reset previous cursor
+  (replace-character 2:terminal-address/raw ((#\+ literal)))
+  ; move cursor up 3 more lines
+  (s:string-address <- new "kkk")
+  (k:keyboard-address <- init-keyboard s:string-address)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (replace-character 2:terminal-address/raw ((#\* literal)))
+  )
+; cursor is now at line 3
+(when (~memory-contains-array memory*.4
+         (+ "                                                                      "
+            "                                                                      "
+            "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal)))                 "
+            "+ main/ 0 : 1 => ((1 integer))                                        "
+            "* main/ 1 : (((2 integer)) <- ((copy)) ((3 literal)))                 "
+            ;^cursor
+            "+ main/ 1 : 3 => ((2 integer))                                        "
+            "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer)))    "
+            "+ main/ 2 : 4 => ((3 integer))                                        "))
+  (prn "F - process-key can move up multiple times"))
+; try to move cursor up thrice more
+(run-code main3
+  (default-space:space-address <- new space:literal 30:literal/capacity)
+  (replace-character 2:terminal-address/raw ((#\+ literal)))
+  (s:string-address <- new "kkk")
+  (k:keyboard-address <- init-keyboard s:string-address)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (replace-character 2:terminal-address/raw ((#\* literal)))
+  )
+; cursor doesn't go beyond the first line printed
+; stuff on screen before screen-state was initialized is inviolate
+(when (~memory-contains-array memory*.4
+         (+ "                                                                      "
+            "                                                                      "
+            "* main/ 0 : (((1 integer)) <- ((copy)) ((1 literal)))                 "
+            ;^cursor
+            "+ main/ 0 : 1 => ((1 integer))                                        "
+            "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal)))                 "
+            "+ main/ 1 : 3 => ((2 integer))                                        "
+            "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer)))    "
+            "+ main/ 2 : 4 => ((3 integer))                                        "))
+  (prn "F - process-key doesn't move above bounds"))
+; now move cursor down 4 times
+(run-code main4
+  (default-space:space-address <- new space:literal 30:literal/capacity)
+  (replace-character 2:terminal-address/raw ((#\+ literal)))
+  (s:string-address <- new "jjjj")
+  (k:keyboard-address <- init-keyboard s:string-address)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (replace-character 2:terminal-address/raw ((#\* literal)))
+  )
+(when (~memory-contains-array memory*.4
+         (+ "                                                                      "
+            "                                                                      "
+            "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal)))                 "
+            "+ main/ 0 : 1 => ((1 integer))                                        "
+            "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal)))                 "
+            "+ main/ 1 : 3 => ((2 integer))                                        "
+            "* main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer)))    "
+            ;^cursor
+            "+ main/ 2 : 4 => ((3 integer))                                        "))
+  (prn "F - process-key can move down multiple times"))
+; try to move cursor down 4 more times
+(run-code main5
+  (default-space:space-address <- new space:literal 30:literal/capacity)
+  (replace-character 2:terminal-address/raw ((#\+ literal)))
+  (s:string-address <- new "jjjj")
+  (k:keyboard-address <- init-keyboard s:string-address)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (process-key 3:space-address/raw/screen-state k:keyboard-address 2:terminal-address/raw 1:instruction-trace-address-array-address/raw)
+  (replace-character 2:terminal-address/raw ((#\* literal)))
+  )
+(when (~memory-contains-array memory*.4
+         (+ "                                                                      "
+            "                                                                      "
+            "+ main/ 0 : (((1 integer)) <- ((copy)) ((1 literal)))                 "
+            "+ main/ 0 : 1 => ((1 integer))                                        "
+            "+ main/ 1 : (((2 integer)) <- ((copy)) ((3 literal)))                 "
+            "+ main/ 1 : 3 => ((2 integer))                                        "
+            "+ main/ 2 : (((3 integer)) <- ((add)) ((1 integer)) ((2 integer)))    "
+            "+ main/ 2 : 4 => ((3 integer))                                        "
+            "*                                                                     "))
+  (prn "F - process-key doesn't move below bounds"))
+
+(reset)
diff --git a/vimrc.vim b/vimrc.vim
new file mode 100644
index 00000000..82fb587b
--- /dev/null
+++ b/vimrc.vim
@@ -0,0 +1 @@
+syntax sync minlines=999