about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorKartik Agaram <vc@akkartik.com>2020-10-10 01:28:50 -0700
committerKartik Agaram <vc@akkartik.com>2020-10-10 01:42:58 -0700
commite8367b2bc2504b62a37ed6fd1bbc7ef2b6407eb2 (patch)
treed657d0f84de6b8039e84f86133abba34c7f7f3c6
parentf864cf0874147a1613960d6f799ec2c764faa482 (diff)
downloadmu-e8367b2bc2504b62a37ed6fd1bbc7ef2b6407eb2.tar.gz
6987 - left-arrow to jump to caller/callee
Starting to work. I'm still seeing problems in lines with multiple expanded
calls, but perhaps that's a rendering issue.

The code is absolutely ghastly.
-rw-r--r--apps/tile/data.mu168
-rw-r--r--apps/tile/environment.mu81
-rw-r--r--apps/tile/main.mu76
3 files changed, 234 insertions, 91 deletions
diff --git a/apps/tile/data.mu b/apps/tile/data.mu
index 59918cf1..bab6215a 100644
--- a/apps/tile/data.mu
+++ b/apps/tile/data.mu
@@ -107,75 +107,88 @@ fn create-primitive-functions _self: (addr handle function) {
   var body/eax: (addr line) <- lookup *body-ah
   initialize-line body
   var curr-word-ah/ecx: (addr handle word) <- get body, data
+  # *curr-word = "x"
   allocate curr-word-ah
-  var curr-word/eax: (addr word) <- lookup *curr-word-ah
+  var tmp/eax: (addr word) <- lookup *curr-word-ah
+  var curr-word/edx: (addr word) <- copy tmp
   initialize-word-with curr-word, "x"
-  curr-word-ah <- get curr-word, next
-  allocate curr-word-ah
-  curr-word <- lookup *curr-word-ah
-  initialize-word-with curr-word, "2"
-  curr-word-ah <- get curr-word, next
-  allocate curr-word-ah
-  curr-word <- lookup *curr-word-ah
-  initialize-word-with curr-word, "*"
-  # x 1+ = x 1 +
-  var next/esi: (addr handle function) <- get f, next
-  allocate next
-  var _f/eax: (addr function) <- lookup *next
-  var f/esi: (addr function) <- copy _f
-  var name-ah/eax: (addr handle array byte) <- get f, name
-  populate-text-with name-ah, "1+"
-  var args-ah/eax: (addr handle word) <- get f, args
-  allocate args-ah
-  var args/eax: (addr word) <- lookup *args-ah
-  initialize-word-with args, "x"
-  var body-ah/eax: (addr handle line) <- get f, body
-  allocate body-ah
-  var body/eax: (addr line) <- lookup *body-ah
-  initialize-line body
-  var curr-word-ah/ecx: (addr handle word) <- get body, data
-  allocate curr-word-ah
-  var curr-word/eax: (addr word) <- lookup *curr-word-ah
-  initialize-word-with curr-word, "x"
-  curr-word-ah <- get curr-word, next
-  allocate curr-word-ah
-  curr-word <- lookup *curr-word-ah
-  initialize-word-with curr-word, "1"
-  curr-word-ah <- get curr-word, next
-  allocate curr-word-ah
-  curr-word <- lookup *curr-word-ah
-  initialize-word-with curr-word, "+"
-  # x 2+ = x 1+ 1+
-  var next/esi: (addr handle function) <- get f, next
-  allocate next
-  var _f/eax: (addr function) <- lookup *next
-  var f/ecx: (addr function) <- copy _f
-  var name-ah/eax: (addr handle array byte) <- get f, name
-  populate-text-with name-ah, "2+"
-  var args-ah/eax: (addr handle word) <- get f, args
-  allocate args-ah
-  var args/eax: (addr word) <- lookup *args-ah
-  initialize-word-with args, "x"
-  var body-ah/eax: (addr handle line) <- get f, body
-  allocate body-ah
-  var body/eax: (addr line) <- lookup *body-ah
-  initialize-line body
-  var curr-word-ah/ecx: (addr handle word) <- get body, data
-  allocate curr-word-ah
-  var curr-word/eax: (addr word) <- lookup *curr-word-ah
-  initialize-word-with curr-word, "x"
-  curr-word-ah <- get curr-word, next
-  allocate curr-word-ah
-  curr-word <- lookup *curr-word-ah
-  initialize-word-with curr-word, "1+"
-  curr-word-ah <- get curr-word, next
-  allocate curr-word-ah
-  curr-word <- lookup *curr-word-ah
-  initialize-word-with curr-word, "1+"
-  # TODO: populate prev pointers
+  # *curr-word->next = "2"
+  var next-word-ah/ebx: (addr handle word) <- get curr-word, next
+  allocate next-word-ah
+  tmp <- lookup *next-word-ah
+  initialize-word-with tmp, "2"
+  # *curr-word->next->prev = curr-word
+  var prev-word-ah/edi: (addr handle word) <- get tmp, prev
+  copy-object curr-word-ah, prev-word-ah
+  # curr-word = curr-word->next
+  curr-word-ah <- copy next-word-ah
+  curr-word <- copy tmp
+  # *curr-word->next = "*"
+  next-word-ah <- get curr-word, next
+  allocate next-word-ah
+  tmp <- lookup *next-word-ah
+  initialize-word-with tmp, "*"
+  # *curr-word->next->prev = curr-word
+  prev-word-ah <- get tmp, prev
+  copy-object curr-word-ah, prev-word-ah
+  tmp <- lookup *prev-word-ah
+#?   # x 1+ = x 1 +
+#?   var next/esi: (addr handle function) <- get f, next
+#?   allocate next
+#?   var _f/eax: (addr function) <- lookup *next
+#?   var f/esi: (addr function) <- copy _f
+#?   var name-ah/eax: (addr handle array byte) <- get f, name
+#?   populate-text-with name-ah, "1+"
+#?   var args-ah/eax: (addr handle word) <- get f, args
+#?   allocate args-ah
+#?   var args/eax: (addr word) <- lookup *args-ah
+#?   initialize-word-with args, "x"
+#?   var body-ah/eax: (addr handle line) <- get f, body
+#?   allocate body-ah
+#?   var body/eax: (addr line) <- lookup *body-ah
+#?   initialize-line body
+#?   var curr-word-ah/ecx: (addr handle word) <- get body, data
+#?   allocate curr-word-ah
+#?   var curr-word/eax: (addr word) <- lookup *curr-word-ah
+#?   initialize-word-with curr-word, "x"
+#?   curr-word-ah <- get curr-word, next
+#?   allocate curr-word-ah
+#?   curr-word <- lookup *curr-word-ah
+#?   initialize-word-with curr-word, "1"
+#?   curr-word-ah <- get curr-word, next
+#?   allocate curr-word-ah
+#?   curr-word <- lookup *curr-word-ah
+#?   initialize-word-with curr-word, "+"
+#?   # x 2+ = x 1+ 1+
+#?   var next/esi: (addr handle function) <- get f, next
+#?   allocate next
+#?   var _f/eax: (addr function) <- lookup *next
+#?   var f/ecx: (addr function) <- copy _f
+#?   var name-ah/eax: (addr handle array byte) <- get f, name
+#?   populate-text-with name-ah, "2+"
+#?   var args-ah/eax: (addr handle word) <- get f, args
+#?   allocate args-ah
+#?   var args/eax: (addr word) <- lookup *args-ah
+#?   initialize-word-with args, "x"
+#?   var body-ah/eax: (addr handle line) <- get f, body
+#?   allocate body-ah
+#?   var body/eax: (addr line) <- lookup *body-ah
+#?   initialize-line body
+#?   var curr-word-ah/ecx: (addr handle word) <- get body, data
+#?   allocate curr-word-ah
+#?   var curr-word/eax: (addr word) <- lookup *curr-word-ah
+#?   initialize-word-with curr-word, "x"
+#?   curr-word-ah <- get curr-word, next
+#?   allocate curr-word-ah
+#?   curr-word <- lookup *curr-word-ah
+#?   initialize-word-with curr-word, "1+"
+#?   curr-word-ah <- get curr-word, next
+#?   allocate curr-word-ah
+#?   curr-word <- lookup *curr-word-ah
+#?   initialize-word-with curr-word, "1+"
 }
 
-fn function-body in: (addr handle function), _word: (addr handle word), out: (addr handle line) {
+fn function-body functions: (addr handle function), _word: (addr handle word), out: (addr handle line) {
   var function-name-storage: (handle array byte)
   var function-name-ah/ecx: (addr handle array byte) <- address function-name-storage
   var word-ah/esi: (addr handle word) <- copy _word
@@ -185,7 +198,7 @@ fn function-body in: (addr handle function), _word: (addr handle word), out: (ad
   gap-buffer-to-string gap, function-name-ah
   var _function-name/eax: (addr array byte) <- lookup *function-name-ah
   var function-name/esi: (addr array byte) <- copy _function-name
-  var curr-ah/ecx: (addr handle function) <- copy in
+  var curr-ah/ecx: (addr handle function) <- copy functions
   $function-body:loop: {
     var _curr/eax: (addr function) <- lookup *curr-ah
     var curr/edx: (addr function) <- copy _curr
@@ -206,6 +219,29 @@ fn function-body in: (addr handle function), _word: (addr handle word), out: (ad
   }
 }
 
+fn body-length functions: (addr handle function), function-name: (addr handle word) -> result/eax: int {
+  var body-storage: (handle line)
+  var body-ah/edi: (addr handle line) <- address body-storage
+  function-body functions, function-name, body-ah
+  var body/eax: (addr line) <- lookup *body-ah
+  result <- line-length body
+}
+
+fn line-length _in: (addr line) -> result/eax: int {
+  var in/esi: (addr line) <- copy _in
+  var curr-ah/ecx: (addr handle word) <- get in, data
+  var out/edi: int <- copy 0
+  {
+    var curr/eax: (addr word) <- lookup *curr-ah
+    compare curr, 0
+    break-if-=
+    curr-ah <- get curr, next
+    out <- increment
+    loop
+  }
+  result <- copy out
+}
+
 fn populate-text-with _out: (addr handle array byte), _in: (addr array byte) {
   var in/esi: (addr array byte) <- copy _in
   var n/ecx: int <- length in
diff --git a/apps/tile/environment.mu b/apps/tile/environment.mu
index 71da0ddc..4a76b03f 100644
--- a/apps/tile/environment.mu
+++ b/apps/tile/environment.mu
@@ -86,27 +86,90 @@ $process:body: {
     var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
     var cursor-word/ecx: (addr word) <- copy _cursor-word
     compare key, 0x445b1b  # left-arrow
-    {
+    $process:key-left-arrow: {
       break-if-!=
+#?       print-string 0, "left-arrow\n"
       # if not at start, move left within current word
       var at-start?/eax: boolean <- cursor-at-start? cursor-word
       compare at-start?, 0  # false
       {
         break-if-=
+#?         print-string 0, "cursor left within word\n"
         cursor-left cursor-word
         break $process:body
       }
-      # otherwise, move to end of prev word
+      # if current word is expanded, move to the rightmost word in its body
+      {
+        var cursor-call-path/esi: (addr handle call-path-element) <- get sandbox, cursor-call-path
+        var expanded-words/edx: (addr handle call-path) <- get sandbox, expanded-words
+        var curr-word-is-expanded?/eax: boolean <- find-in-call-path expanded-words, cursor-call-path
+        compare curr-word-is-expanded?, 0  # false
+        break-if-=
+#?         print-string 0, "curr word is expanded\n"
+        var self/ecx: (addr environment) <- copy _self
+        var functions/ecx: (addr handle function) <- get self, functions
+        {
+          var curr-word-is-expanded?/eax: boolean <- find-in-call-path expanded-words, cursor-call-path
+          compare curr-word-is-expanded?, 0  # false
+          break-if-=
+          var n/eax: int <- body-length functions, cursor-word-ah
+          n <- decrement
+          push-to-call-path-element cursor-call-path, n
+          loop
+        }
+        # move cursor to end of word
+        get-cursor-word sandbox, functions, cursor-word-ah
+        var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
+        cursor-to-end cursor-word
+        break $process:body
+      }
+      # if at first word, look for a caller to jump to
+      $process:key-left-arrow-caller: {
+        var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
+        var prev-word/eax: (addr word) <- lookup *prev-word-ah
+        compare prev-word, 0
+        break-if-!=
+        $process:key-left-arrow-caller-loop: {
+          compare prev-word, 0
+          break-if-!=
+#?           print-string 0, "return\n"
+          {
+            var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
+            var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
+            var next-cursor-element-ah/edx: (addr handle call-path-element) <- get cursor-call-path, next
+            var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
+            compare next-cursor-element, 0
+            break-if-= $process:key-left-arrow-caller-loop
+            copy-object next-cursor-element-ah, cursor-call-path-ah
+          }
+          var functions/eax: (addr handle function) <- get self, functions
+          get-cursor-word sandbox, functions, cursor-word-ah
+          var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
+          cursor-word <- copy _cursor-word
+          loop
+        }
+        # then move to end of caller's previous word
+        {
+          var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
+          var prev-word/eax: (addr word) <- lookup *prev-word-ah
+          compare prev-word, 0
+          break-if-=
+#?           print-string 0, "jump before caller\n"
+          copy-object prev-word-ah, cursor-word-ah
+          cursor-to-end prev-word
+          var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
+          decrement-final-element cursor-call-path
+        }
+        break $process:body
+      }
+      # otherwise, move to end of previous word
       var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
       var prev-word/eax: (addr word) <- lookup *prev-word-ah
       {
         compare prev-word, 0
         break-if-=
+#?         print-string 0, "previous word\n"
         copy-object prev-word-ah, cursor-word-ah
-        # Is it expanded? If so, it's a function call. Move to the rightmost
-        # word in the function's body
-          # HERE
-        # otherwise move to end of word
         cursor-to-end prev-word
         var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
         decrement-final-element cursor-call-path
@@ -114,7 +177,7 @@ $process:body: {
       break $process:body
     }
     compare key, 0x435b1b  # right-arrow
-    {
+    $process:key-right-arrow: {
       break-if-!=
       # if not at end, move right within current word
       var at-end?/eax: boolean <- cursor-at-end? cursor-word
@@ -140,7 +203,7 @@ $process:body: {
         copy-object next-cursor-element-ah, cursor-call-path-ah
         break $process:body
       }
-      # otherwise, move to a new word
+      # otherwise, move to the next word
       var next-word-ah/edx: (addr handle word) <- get cursor-word, next
       var next-word/eax: (addr word) <- lookup *next-word-ah
       {
@@ -148,7 +211,7 @@ $process:body: {
         break-if-=
 #?         print-string 0, "b\n"
         cursor-to-start next-word
-        # cursor-word now out of date
+        # . . cursor-word now out of date
         var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
         increment-final-element cursor-call-path
         # Is the new cursor word expanded? If so, it's a function call. Add a
diff --git a/apps/tile/main.mu b/apps/tile/main.mu
index 5244a9a5..73c30025 100644
--- a/apps/tile/main.mu
+++ b/apps/tile/main.mu
@@ -87,33 +87,77 @@ fn test {
   process env, g
   g <- copy 0x445b1b  # left-arrow
   process env, g
+  {
+    var functions/ecx: (addr handle function) <- get env, functions
+    var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
+    var _sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
+    var sandbox/edi: (addr sandbox) <- copy _sandbox
+    var cursor-word-storage: (handle word)
+    var cursor-word-ah/ebx: (addr handle word) <- address cursor-word-storage
+    get-cursor-word sandbox, functions, cursor-word-ah
+    var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
+    print-word 0, cursor-word
+    print-string-to-real-screen "\n"
+  }
   g <- copy 0x445b1b  # left-arrow
+  print-string-to-real-screen "==\n"
   process env, g
+  {
+    var functions/ecx: (addr handle function) <- get env, functions
+    var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
+    var _sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
+    var sandbox/edi: (addr sandbox) <- copy _sandbox
+    var cursor-word-storage: (handle word)
+    var cursor-word-ah/ebx: (addr handle word) <- address cursor-word-storage
+    get-cursor-word sandbox, functions, cursor-word-ah
+    var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
+    print-word 0, cursor-word
+    print-string-to-real-screen "\n"
+  }
   g <- copy 0x445b1b  # left-arrow
+  print-string-to-real-screen "==\n"
   process env, g
-  g <- copy 0x435b1b  # right-arrow
+  {
+    var functions/ecx: (addr handle function) <- get env, functions
+    var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
+    var _sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
+    var sandbox/edi: (addr sandbox) <- copy _sandbox
+    var cursor-word-storage: (handle word)
+    var cursor-word-ah/ebx: (addr handle word) <- address cursor-word-storage
+    get-cursor-word sandbox, functions, cursor-word-ah
+    var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
+    print-word 0, cursor-word
+    print-string-to-real-screen "\n"
+  }
+  g <- copy 0x445b1b  # left-arrow
+  print-string-to-real-screen "==\n"
   process env, g
   {
+    var functions/ecx: (addr handle function) <- get env, functions
     var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
-    var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
-    var line-ah/eax: (addr handle line) <- get sandbox, data
-    var line/eax: (addr line) <- lookup *line-ah
-    var first-word-ah/eax: (addr handle word) <- get line, data
-    var curr-word/eax: (addr word) <- lookup *first-word-ah
-    print-word 0, curr-word
-    print-string 0, "\n"
+    var _sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
+    var sandbox/edi: (addr sandbox) <- copy _sandbox
+    var cursor-word-storage: (handle word)
+    var cursor-word-ah/ebx: (addr handle word) <- address cursor-word-storage
+    get-cursor-word sandbox, functions, cursor-word-ah
+    var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
+    print-word 0, cursor-word
+    print-string-to-real-screen "\n"
   }
-  g <- copy 0x435b1b  # right-arrow
+  g <- copy 0x445b1b  # left-arrow
+  print-string-to-real-screen "==\n"
   process env, g
   {
+    var functions/ecx: (addr handle function) <- get env, functions
     var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
-    var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
-    var line-ah/eax: (addr handle line) <- get sandbox, data
-    var line/eax: (addr line) <- lookup *line-ah
-    var first-word-ah/eax: (addr handle word) <- get line, data
-    var curr-word/eax: (addr word) <- lookup *first-word-ah
-    print-word 0, curr-word
-    print-string 0, "\n"
+    var _sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
+    var sandbox/edi: (addr sandbox) <- copy _sandbox
+    var cursor-word-storage: (handle word)
+    var cursor-word-ah/ebx: (addr handle word) <- address cursor-word-storage
+    get-cursor-word sandbox, functions, cursor-word-ah
+    var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
+    print-word 0, cursor-word
+    print-string-to-real-screen "\n"
   }
 #?   render env
 }