snapshot: attempt at modifying a function name

It turns out there's another problem, and it predates the ability to create
new definitions:

  ctrl-s triggers a call to `evaluate`, which inserts a new definition
  into globals. which has a null gap buffer.

All this happens long before the new code in this commit, resulting in a
null gap buffer by the time we get to word-at-cursor.

Which in turn happens because we perform a raw `evaluate`, which doesn't
update the gap buffer like `run` does (using `maybe-stash-gap-buffer-to-global`).

And arguably `evaluate` shouldn't mess with the gap buffer. Gap buffers
are a UI concern.

The hardest version of this immediate scenario: It's unclear how to guarantee
that every definition have a gap buffer, when two definitions may share
one (closures sharing a lexical environment).

New plan:
  - improve the logic for detecting definitions. Looking at the outermost
    layer isn't enough. And a single expression can create multiple definitions.
  - extract a helper to attach a single gap buffer to multiple definitions.
  - have the UI detect conflicts in gap buffers and prompt the user for
    a decision if a different gap buffer already exists for a definition.

3 files changed, 135 insertions, 24 deletions

diff --git a/mu-init.subx b/mu-init.subx
index 8fcf84e3..321dd66a 100644
--- a/mu-init.subx
+++ b/mu-init.subx
@@ -14,19 +14,20 @@ Entry:
   bd/copy-to-ebp 0/imm32
   #
 #?   (main 0 0 Primary-bus-secondary-drive)
-  # always first run tests
-  (run-tests)
-  (num-test-failures)  # => eax
-  # call main if tests all passed
-  {
-    3d/compare-eax-and 0/imm32
-    75/jump-if-!= break/disp8
-    c7 0/subop/copy *Running-tests? 0/imm32/false
-    (clear-real-screen)
-    c7 0/subop/copy *Real-screen-cursor-x 0/imm32
-    c7 0/subop/copy *Real-screen-cursor-y 0/imm32
-    (main 0 0 Primary-bus-secondary-drive)
-  }
+  (test-create-function-with-new-name)
+#?   # always first run tests
+#?   (run-tests)
+#?   (num-test-failures)  # => eax
+#?   # call main if tests all passed
+#?   {
+#?     3d/compare-eax-and 0/imm32
+#?     75/jump-if-!= break/disp8
+#?     c7 0/subop/copy *Running-tests? 0/imm32/false
+#?     (clear-real-screen)
+#?     c7 0/subop/copy *Real-screen-cursor-x 0/imm32
+#?     c7 0/subop/copy *Real-screen-cursor-y 0/imm32
+#?     (main 0 0 Primary-bus-secondary-drive)
+#?   }
 
   # hang indefinitely
   {
diff --git a/shell/environment.mu b/shell/environment.mu
index 200dbe14..2ec7da79 100644
--- a/shell/environment.mu
+++ b/shell/environment.mu
@@ -767,6 +767,70 @@ fn test-create-nonexistent-global {
   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-15"
 }
 
+fn test-create-function-with-new-name {
+  var env-storage: environment
+  var env/esi: (addr environment) <- address env-storage
+  initialize-environment env
+  # setup: screen
+  var screen-on-stack: screen
+  var screen/edi: (addr screen) <- address screen-on-stack
+  initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+  # claim to create a definition for 'f'
+  edit-environment env, 7/ctrl-g, 0/no-disk
+  render-environment screen, env
+  type-in env, screen, "f"
+  edit-environment env, 0xd/ctrl-m, 0/no-disk
+  render-environment screen, env
+  # actually create definition for 'g'
+  type-in env, screen, "(define g 42)"
+  edit-environment env, 0x13/ctrl-s, 0/no-disk
+  render-environment screen, env
+  # return to sandbox
+  edit-environment env, 7/ctrl-g, 0/no-disk
+  render-environment screen, env
+  edit-environment env, 0xa/newline, 0/no-disk
+  render-environment screen, env
+  # try to jump to 'f'
+  edit-environment env, 7/ctrl-g, 0/no-disk
+  render-environment screen, env
+  type-in env, screen, "f"
+  edit-environment env, 0xa/newline, 0/no-disk
+  render-environment screen, env
+  # fails
+  #                                                                 | global definitions                                                                 | sandbox
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-create-function-with-new-name/0"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-create-function-with-new-name/1"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-create-function-with-new-name/2"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-create-function-with-new-name/3"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-create-function-with-new-name/4"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-create-function-with-new-name/5"
+  check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-create-function-with-new-name/6-text"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-create-function-with-new-name/6"
+  check-screen-row-in-color            screen, 4/fg=error,     7/y, "                                no such global                                                                                  ", "F - test-create-function-with-new-name/7-text"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-create-function-with-new-name/7"
+  check-screen-row                     screen,                 8/y, "                                f                                                                                               ", "F - test-create-function-with-new-name/8-text"
+  check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                 |                                                                                              ", "F - test-create-function-with-new-name/8-cursor"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                . ..............................................................                                ", "F - test-create-function-with-new-name/8"
+  check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-create-function-with-new-name/9"
+  check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-create-function-with-new-name/10"
+  check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-create-function-with-new-name/11"
+  check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-create-function-with-new-name/12"
+  check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-create-function-with-new-name/13"
+  check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-create-function-with-new-name/14"
+  # jump to 'g'
+  edit-environment env, 0x1b/escape, 0/no-disk
+  render-environment screen, env
+  edit-environment env, 7/ctrl-g, 0/no-disk
+  render-environment screen, env
+  type-in env, screen, "g"
+  edit-environment env, 0xa/newline, 0/no-disk
+  render-environment screen, env
+  # succeeds
+  #                                                                 | global function definitions                                                        | sandbox
+  check-screen-row                     screen,                 1/y, "                                g                                                                                               ", "F - test-create-function-with-new-name/test2"
+  check-background-color-in-screen-row screen,   7/bg=cursor,  1/y, "                                 |                                                                                              ", "F - test-create-function-with-new-name/test2-cursor"
+}
+
 fn render-go-modal screen: (addr screen), _self: (addr environment) {
   var self/esi: (addr environment) <- copy _self
   var width/eax: int <- copy 0
diff --git a/shell/global.mu b/shell/global.mu
index 9b68e91e..a76e7148 100644
--- a/shell/global.mu
+++ b/shell/global.mu
@@ -285,10 +285,41 @@ fn refresh-definition _self: (addr global-table), _index: int {
     var nil-ah/eax: (addr handle cell) <- address nil-h
     allocate-pair nil-ah
   }
-  var curr-value-ah/eax: (addr handle cell) <- get curr-global, value
+  var curr-value-ah/edi: (addr handle cell) <- get curr-global, value
   debug-print "GL", 4/fg, 0/bg
   evaluate read-result-ah, curr-value-ah, nil-h, self, trace, 0/no-screen-cell, 0/no-keyboard-cell, 1/call-number
   debug-print "GZ", 4/fg, 0/bg
+  {
+    var error?/eax: boolean <- has-errors? trace
+    compare error?, 0/false
+    break-if-=
+    return
+  }
+  # update definition name if necessary
+  var curr-global-name-ah/ecx: (addr handle array byte) <- get curr-global, name
+  var _curr-global-name/eax: (addr array byte) <- lookup *curr-global-name-ah
+  var curr-global-name/ebx: (addr array byte) <- copy _curr-global-name
+  var read-result/eax: (addr cell) <- lookup *read-result-ah
+  {
+    var is-definition?/eax: boolean <- is-definition? read-result
+    compare is-definition?, 0/false
+    break-if-!=
+    return
+  }
+  # (no error checking since it's a definition and there were no errors)
+  var rest-ah/eax: (addr handle cell) <- get read-result, right
+  var rest/eax: (addr cell) <- lookup *rest-ah
+  var correct-definition-symbol-ah/eax: (addr handle cell) <- get rest, left
+  var correct-definition-symbol/eax: (addr cell) <- lookup *correct-definition-symbol-ah
+  var correct-definition-name-ah/eax: (addr handle stream byte) <- get correct-definition-symbol, text-data
+  var correct-definition-name/eax: (addr stream byte) <- lookup *correct-definition-name-ah
+  {
+    var still-matches?/eax: boolean <- stream-data-equal? correct-definition-name, curr-global-name
+    compare still-matches?, 0/false
+    break-if-=
+    return
+  }
+  stream-to-array correct-definition-name, curr-global-name-ah
 }
 
 fn assign-or-create-global _self: (addr global-table), name: (addr array byte), value: (handle cell), trace: (addr trace) {
@@ -493,20 +524,14 @@ fn maybe-stash-gap-buffer-to-global _globals: (addr global-table), _expr-ah: (ad
     break-if-=
     return
   }
-  # if expr->left is neither "define" nor "set", return
-  var left-ah/eax: (addr handle cell) <- get expr, left
-  var _left/eax: (addr cell) <- lookup *left-ah
-  var left/ecx: (addr cell) <- copy _left
+  # if expr is not a definition, return
   {
-    var def?/eax: boolean <- symbol-equal? left, "define"
-    compare def?, 0/false
-    break-if-!=
-    var set?/eax: boolean <- symbol-equal? left, "set"
-    compare set?, 0/false
+    var is-definition?/eax: boolean <- is-definition? expr
+    compare is-definition?, 0/false
     break-if-!=
     return
   }
-  # locate the global for expr->right->left
+  # locate the global for definition->right->left
   var right-ah/eax: (addr handle cell) <- get expr, right
   var right/eax: (addr cell) <- lookup *right-ah
   var defined-symbol-ah/eax: (addr handle cell) <- get right, left
@@ -542,6 +567,27 @@ fn maybe-stash-gap-buffer-to-global _globals: (addr global-table), _expr-ah: (ad
   initialize-gap-buffer gap-addr, capacity
 }
 
+fn is-definition? _expr: (addr cell) -> _/eax: boolean {
+  var expr/eax: (addr cell) <- copy _expr
+  # if expr->left is neither "define" nor "set", return
+  var left-ah/eax: (addr handle cell) <- get expr, left
+  var _left/eax: (addr cell) <- lookup *left-ah
+  var left/ecx: (addr cell) <- copy _left
+  {
+    var def?/eax: boolean <- symbol-equal? left, "define"
+    compare def?, 0/false
+    break-if-=
+    return 1/true
+  }
+  {
+    var set?/eax: boolean <- symbol-equal? left, "set"
+    compare set?, 0/false
+    break-if-=
+    return 1/true
+  }
+  return 0/false
+}
+
 # Accepts an input s-expression, naively checks if it is a definition, and if
 # so saves the gap-buffer to the appropriate global.
 fn move-gap-buffer-to-global _globals: (addr global-table), _definition-ah: (addr handle cell), gap: (addr handle gap-buffer) {