https://github.com/akkartik/mu/blob/main/linux/tile/environment.mu
   1 # The architecture that seems to be crystallizing: the environment has two
   2 # areas: functions and sandbox.
   3 #
   4 # Rendering the environment requires rendering all areas.
   5 # Displaying the cursor requires displaying cursor for the area controlling the cursor.
   6 # Processing events for the environment requires processing events for the area controlling the cursor.
   7 #
   8 # Areas can have dialogs.
   9 # There can also be global dialogs (currently just one: goto function).
  10 # Areas are responsible for rendering their dialogs.
  11 # In practice this results in dialogs encapsulating the state they need to
  12 # decide whether to render.
  13 #
  14 # This will be useful if we add more areas in the future.
  15 
  16 type environment {
  17   screen: (handle screen)
  18   functions: (handle function)
  19   sandboxes: (handle sandbox)
  20   partial-function-name: (handle word)
  21   # at most one of these will be set
  22   cursor-function: (handle function)
  23   cursor-sandbox: (handle sandbox)
  24   #
  25   nrows: int
  26   ncols: int
  27   code-separator-col: int
  28 }
  29 
  30 fn initialize-environment _env: (addr environment) {
  31   var env/esi: (addr environment) <- copy _env
  32   # initialize some predefined function definitions
  33   var functions/eax: (addr handle function) <- get env, functions
  34   create-primitive-functions functions
  35   # initialize first sandbox
  36   var sandbox-ah/ecx: (addr handle sandbox) <- get env, sandboxes
  37   allocate sandbox-ah
  38   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
  39   initialize-sandbox sandbox
  40   # initialize cursor sandbox
  41   var cursor-sandbox-ah/eax: (addr handle sandbox) <- get env, cursor-sandbox
  42   copy-object sandbox-ah, cursor-sandbox-ah
  43   # initialize screen
  44   var screen-ah/eax: (addr handle screen) <- get env, screen
  45   var _screen/eax: (addr screen) <- lookup *screen-ah
  46   var screen/edi: (addr screen) <- copy _screen
  47   var nrows/eax: int <- copy 0
  48   var ncols/ecx: int <- copy 0
  49   nrows, ncols <- screen-size screen
  50   var dest/edx: (addr int) <- get env, nrows
  51   copy-to *dest, nrows
  52   dest <- get env, ncols
  53   copy-to *dest, ncols
  54   var repl-col/ecx: int <- copy ncols
  55   repl-col <- shift-right 1
  56   dest <- get env, code-separator-col
  57   copy-to *dest, repl-col
  58 }
  59 
  60 fn initialize-environment-with-fake-screen _self: (addr environment), nrows: int, ncols: int {
  61   var self/esi: (addr environment) <- copy _self
  62   var screen-ah/eax: (addr handle screen) <- get self, screen
  63   allocate screen-ah
  64   var screen-addr/eax: (addr screen) <- lookup *screen-ah
  65   initialize-screen screen-addr, nrows, ncols
  66   initialize-environment self
  67 }
  68 
  69 #############
  70 # Iterate
  71 #############
  72 
  73 fn process _self: (addr environment), key: code-point-utf8 {
  74   var self/esi: (addr environment) <- copy _self
  75   var fn-name-ah/eax: (addr handle word) <- get self, partial-function-name
  76   var fn-name/eax: (addr word) <- lookup *fn-name-ah
  77   compare fn-name, 0
  78   {
  79     break-if-=
  80 #?     print-string 0, "processing goto fn\n"
  81     process-goto-dialog self, key
  82     return
  83   }
  84   var function-ah/eax: (addr handle function) <- get self, cursor-function
  85   var function/eax: (addr function) <- lookup *function-ah
  86   compare function, 0
  87   {
  88     break-if-=
  89 #?     print-string 0, "processing function\n"
  90     process-function self, function, key
  91     return
  92   }
  93   var sandbox-ah/eax: (addr handle sandbox) <- get self, cursor-sandbox
  94   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
  95   compare sandbox, 0
  96   {
  97     break-if-=
  98 #?     print-string 0, "processing sandbox\n"
  99     process-sandbox self, sandbox, key
 100     return
 101   }
 102 }
 103 
 104 # collect new name in partial-function-name, and move the cursor to function with that name
 105 fn process-goto-dialog _self: (addr environment), key: code-point-utf8 {
 106   var self/esi: (addr environment) <- copy _self
 107   var fn-name-ah/edi: (addr handle word) <- get self, partial-function-name
 108   # if 'esc' pressed, cancel goto
 109   compare key, 0x1b/esc
 110   $process-goto-dialog:cancel: {
 111     break-if-!=
 112     clear-object fn-name-ah
 113     return
 114   }
 115   # if 'enter' pressed, location function and set cursor to it
 116   compare key, 0xa/enter
 117   $process-goto-dialog:commit: {
 118     break-if-!=
 119 #?     print-string 0, "jump\n"
 120     var fn-name/eax: (addr word) <- lookup *fn-name-ah
 121     var functions/ecx: (addr handle function) <- get self, functions
 122     var dest/edx: (addr handle function) <- get self, cursor-function
 123     callee functions, fn-name, dest
 124     # we won't clear cursor-sandbox until we start supporting multiple sandboxes
 125     clear-object fn-name-ah
 126     # there shouldn't be any need to clear state for other dialogs in the sandbox
 127     return
 128   }
 129   #
 130   compare key, 0x7f/del  # backspace on Macs
 131   $process-goto-dialog:backspace: {
 132     break-if-!=
 133     # if not at start, delete code-point-utf8 before cursor
 134     var fn-name/eax: (addr word) <- lookup *fn-name-ah
 135     var at-start?/eax: boolean <- cursor-at-start? fn-name
 136     compare at-start?, 0/false
 137     {
 138       break-if-!=
 139       var fn-name/eax: (addr word) <- lookup *fn-name-ah
 140       delete-before-cursor fn-name
 141     }
 142     return
 143   }
 144   # otherwise insert key within current word
 145   var print?/eax: boolean <- real-code-point-utf8? key
 146   $process-goto-dialog:real-code-point-utf8: {
 147     compare print?, 0/false
 148     break-if-=
 149     var fn-name/eax: (addr word) <- lookup *fn-name-ah
 150     add-code-point-utf8-to-word fn-name, key
 151     return
 152   }
 153   # silently ignore other hotkeys
 154 }
 155 
 156 fn process-function _self: (addr environment), _function: (addr function), key: code-point-utf8 {
 157   var self/esi: (addr environment) <- copy _self
 158   var function/edi: (addr function) <- copy _function
 159   process-function-edit self, function, key
 160 }
 161 
 162 fn process-function-edit _self: (addr environment), _function: (addr function), key: code-point-utf8 {
 163   var self/esi: (addr environment) <- copy _self
 164   var function/edi: (addr function) <- copy _function
 165   var cursor-word-ah/ebx: (addr handle word) <- get function, cursor-word
 166   var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 167   var cursor-word/ecx: (addr word) <- copy _cursor-word
 168   compare key, 0x445b1b/left-arrow
 169   $process-function-edit:key-left-arrow: {
 170     break-if-!=
 171 #?     print-string 0, "left-arrow\n"
 172     # if not at start, move left within current word
 173     var at-start?/eax: boolean <- cursor-at-start? cursor-word
 174     compare at-start?, 0/false
 175     {
 176       break-if-!=
 177 #?       print-string 0, "cursor left within word\n"
 178       cursor-left cursor-word
 179       return
 180     }
 181     # otherwise move to end of previous word
 182     var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 183     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 184     {
 185       compare prev-word, 0
 186       break-if-=
 187 #?       print-string 0, "move to previous word\n"
 188       cursor-to-end prev-word
 189       copy-object prev-word-ah, cursor-word-ah
 190     }
 191     return
 192   }
 193   compare key, 0x435b1b/right-arrow
 194   $process-function-edit:key-right-arrow: {
 195     break-if-!=
 196     # if not at end, move right within current word
 197     var at-end?/eax: boolean <- cursor-at-end? cursor-word
 198     compare at-end?, 0/false
 199     {
 200       break-if-!=
 201       cursor-right cursor-word
 202       return
 203     }
 204     # otherwise, move to the next word
 205     var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 206     var next-word/eax: (addr word) <- lookup *next-word-ah
 207     {
 208       compare next-word, 0
 209       break-if-=
 210       cursor-to-start next-word
 211       copy-object next-word-ah, cursor-word-ah
 212     }
 213     return
 214   }
 215   # word-based motions
 216   compare key, 2/ctrl-b
 217   $process-function-edit:prev-word: {
 218     break-if-!=
 219     # jump to previous word if possible
 220     var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 221     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 222     {
 223       compare prev-word, 0
 224       break-if-=
 225       cursor-to-end prev-word
 226       copy-object prev-word-ah, cursor-word-ah
 227     }
 228     return
 229   }
 230   compare key, 6/ctrl-f
 231   $process-function-edit:next-word: {
 232     break-if-!=
 233     # jump to previous word if possible
 234     var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 235     var next-word/eax: (addr word) <- lookup *next-word-ah
 236     {
 237       compare next-word, 0
 238       break-if-=
 239       cursor-to-end next-word
 240       copy-object next-word-ah, cursor-word-ah
 241     }
 242     return
 243   }
 244   # line-based motions
 245   compare key, 1/ctrl-a
 246   $process-function-edit:start-of-line: {
 247     break-if-!=
 248     # move cursor to start of first word
 249     var body-ah/eax: (addr handle line) <- get function, body
 250     var body/eax: (addr line) <- lookup *body-ah
 251     var body-contents-ah/ecx: (addr handle word) <- get body, data
 252     copy-object body-contents-ah, cursor-word-ah
 253     var body-contents/eax: (addr word) <- lookup *body-contents-ah
 254     cursor-to-start body-contents
 255     return
 256   }
 257   compare key, 5/ctrl-e
 258   $process-function-edit:end-of-line: {
 259     break-if-!=
 260     # move cursor to end of final word
 261     var body-ah/eax: (addr handle line) <- get function, body
 262     var body/eax: (addr line) <- lookup *body-ah
 263     var body-contents-ah/ecx: (addr handle word) <- get body, data
 264     copy-object body-contents-ah, cursor-word-ah
 265     final-word cursor-word-ah, cursor-word-ah
 266     var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 267     cursor-to-end cursor-word
 268     return
 269   }
 270   # bounce to another function
 271   compare key, 7/ctrl-g
 272   $process-function-edit:goto-function: {
 273     break-if-!=
 274     # initialize dialog to name function to jump to
 275     var partial-function-name-ah/eax: (addr handle word) <- get self, partial-function-name
 276     allocate partial-function-name-ah
 277     var partial-function-name/eax: (addr word) <- lookup *partial-function-name-ah
 278     initialize-word partial-function-name
 279     return
 280   }
 281   # bounce to sandbox
 282   compare key, 9/tab
 283   $process-function-edit:goto-sandbox: {
 284     break-if-!=
 285     var function-ah/eax: (addr handle function) <- get self, cursor-function
 286     clear-object function-ah
 287     return
 288   }
 289   # editing the current function
 290   compare key, 0x7f/del  # backspace on Macs
 291   $process-function-edit:backspace: {
 292     break-if-!=
 293     # if not at start of some word, delete code-point-utf8 before cursor within current word
 294     var at-start?/eax: boolean <- cursor-at-start? cursor-word
 295     compare at-start?, 0/false
 296     {
 297       break-if-!=
 298       delete-before-cursor cursor-word
 299       return
 300     }
 301     # otherwise delete current word and move to end of prev word
 302     var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 303     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 304     {
 305       compare prev-word, 0
 306       break-if-=
 307       cursor-to-end prev-word
 308       delete-next prev-word
 309       copy-object prev-word-ah, cursor-word-ah
 310     }
 311     return
 312   }
 313   compare key, 0x20/space
 314   $process-function-edit:space: {
 315     break-if-!=
 316 #?     print-string 0, "space\n"
 317     # if cursor is at start of word, insert word before
 318     {
 319       var at-start?/eax: boolean <- cursor-at-start? cursor-word
 320       compare at-start?, 0/false
 321       break-if-=
 322       var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
 323       append-word prev-word-ah
 324       var new-prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
 325       copy-object new-prev-word-ah, cursor-word-ah
 326       return
 327     }
 328     # if start of word is quote and code-point-utf8 before cursor is not, just insert it as usual
 329     # TODO: support string escaping
 330     {
 331       var first-code-point-utf8/eax: code-point-utf8 <- first-code-point-utf8 cursor-word
 332       compare first-code-point-utf8, 0x22/double-quote
 333       break-if-!=
 334       var final-code-point-utf8/eax: code-point-utf8 <- code-point-utf8-before-cursor cursor-word
 335       compare final-code-point-utf8, 0x22/double-quote
 336       break-if-=
 337       break $process-function-edit:space
 338     }
 339     # if start of word is '[' and code-point-utf8 before cursor is not ']', just insert it as usual
 340     # TODO: support nested arrays
 341     {
 342       var first-code-point-utf8/eax: code-point-utf8 <- first-code-point-utf8 cursor-word
 343       compare first-code-point-utf8, 0x5b/[
 344       break-if-!=
 345       var final-code-point-utf8/eax: code-point-utf8 <- code-point-utf8-before-cursor cursor-word
 346       compare final-code-point-utf8, 0x5d/]
 347       break-if-=
 348       break $process-function-edit:space
 349     }
 350     # otherwise insert word after and move cursor to it for the next key
 351     # (but we'll continue to track the current cursor-word for the rest of this function)
 352     append-word cursor-word-ah
 353     var next-word-ah/eax: (addr handle word) <- get cursor-word, next
 354     copy-object next-word-ah, cursor-word-ah
 355     # if cursor is at end of word, that's all
 356     var at-end?/eax: boolean <- cursor-at-end? cursor-word
 357     compare at-end?, 0/false
 358     {
 359       break-if-=
 360       return
 361     }
 362     # otherwise we're in the middle of a word
 363     # move everything after cursor to the (just created) next word
 364     var next-word-ah/eax: (addr handle word) <- get cursor-word, next
 365     var _next-word/eax: (addr word) <- lookup *next-word-ah
 366     var next-word/ebx: (addr word) <- copy _next-word
 367     {
 368       var at-end?/eax: boolean <- cursor-at-end? cursor-word
 369       compare at-end?, 0/false
 370       break-if-!=
 371       var g/eax: code-point-utf8 <- pop-after-cursor cursor-word
 372       add-code-point-utf8-to-word next-word, g
 373       loop
 374     }
 375     cursor-to-start next-word
 376     return
 377   }
 378   # otherwise insert key within current word
 379   var g/edx: code-point-utf8 <- copy key
 380   var print?/eax: boolean <- real-code-point-utf8? key
 381   $process-function-edit:real-code-point-utf8: {
 382     compare print?, 0/false
 383     break-if-=
 384     add-code-point-utf8-to-word cursor-word, g
 385     return
 386   }
 387   # silently ignore other hotkeys
 388 }
 389 
 390 fn process-sandbox _self: (addr environment), _sandbox: (addr sandbox), key: code-point-utf8 {
 391   var self/esi: (addr environment) <- copy _self
 392   var sandbox/edi: (addr sandbox) <- copy _sandbox
 393   var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 394   var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah?
 395   compare rename-word-mode?, 0
 396   {
 397     break-if-=
 398 #?     print-string 0, "processing sandbox rename\n"
 399     process-sandbox-rename sandbox, key
 400     return
 401   }
 402   var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function
 403   var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah?
 404   compare define-function-mode?, 0
 405   {
 406     break-if-=
 407 #?     print-string 0, "processing function definition\n"
 408     var functions/ecx: (addr handle function) <- get self, functions
 409     process-sandbox-define sandbox, functions, key
 410     return
 411   }
 412 #?   print-string 0, "processing sandbox edit\n"
 413   process-sandbox-edit self, sandbox, key
 414 }
 415 
 416 fn process-sandbox-edit _self: (addr environment), _sandbox: (addr sandbox), key: code-point-utf8 {
 417   var self/esi: (addr environment) <- copy _self
 418   var sandbox/edi: (addr sandbox) <- copy _sandbox
 419   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 420   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 421   var cursor-word-ah/ebx: (addr handle word) <- get cursor-call-path, word
 422   var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 423   var cursor-word/ecx: (addr word) <- copy _cursor-word
 424   compare key, 0x445b1b/left-arrow
 425   $process-sandbox-edit:key-left-arrow: {
 426     break-if-!=
 427 #?     print-string 0, "left-arrow\n"
 428     # if not at start, move left within current word
 429     var at-start?/eax: boolean <- cursor-at-start? cursor-word
 430     compare at-start?, 0/false
 431     {
 432       break-if-!=
 433 #?       print-string 0, "cursor left within word\n"
 434       cursor-left cursor-word
 435       return
 436     }
 437     # if current word is expanded, move to the rightmost word in its body
 438     {
 439       var cursor-call-path/esi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 440       var expanded-words/edx: (addr handle call-path) <- get sandbox, expanded-words
 441       var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
 442       compare curr-word-is-expanded?, 0/false
 443       break-if-=
 444       # update cursor-call-path
 445 #?       print-string 0, "curr word is expanded\n"
 446       var self/ecx: (addr environment) <- copy _self
 447       var functions/ecx: (addr handle function) <- get self, functions
 448       var body: (handle line)
 449       var body-ah/eax: (addr handle line) <- address body
 450       function-body functions, cursor-word-ah, body-ah
 451       var body-addr/eax: (addr line) <- lookup *body-ah
 452       var first-word-ah/edx: (addr handle word) <- get body-addr, data
 453       var final-word-h: (handle word)
 454       var final-word-ah/eax: (addr handle word) <- address final-word-h
 455       final-word first-word-ah, final-word-ah
 456       push-to-call-path-element cursor-call-path, final-word-ah
 457       # move cursor to end of word
 458       var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 459       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 460       var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 461       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 462       cursor-to-end cursor-word
 463       return
 464     }
 465     # if at first word, look for a caller to jump to
 466     $process-sandbox-edit:key-left-arrow-first-word: {
 467       var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 468       var prev-word/eax: (addr word) <- lookup *prev-word-ah
 469       compare prev-word, 0
 470       break-if-!=
 471       $process-sandbox-edit:key-left-arrow-first-word-and-caller: {
 472 #?         print-string 0, "return\n"
 473         {
 474           var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 475           var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 476           var next-cursor-element-ah/edx: (addr handle call-path-element) <- get cursor-call-path, next
 477           var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
 478           compare next-cursor-element, 0
 479           break-if-= $process-sandbox-edit:key-left-arrow-first-word-and-caller
 480           copy-object next-cursor-element-ah, cursor-call-path-ah
 481         }
 482         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 483         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 484         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 485         var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 486         cursor-word <- copy _cursor-word
 487       }
 488     }
 489     # then move to end of previous word
 490     var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 491     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 492     {
 493       compare prev-word, 0
 494       break-if-=
 495 #?       print-string 0, "move to previous word\n"
 496       cursor-to-end prev-word
 497 #?       {
 498 #?         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 499 #?         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 500 #?         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 501 #?         var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 502 #?         var cursor-word/ebx: (addr word) <- copy _cursor-word
 503 #?         print-string 0, "word at cursor before: "
 504 #?         print-word 0, cursor-word
 505 #?         print-string 0, "\n"
 506 #?       }
 507       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 508       decrement-final-element cursor-call-path
 509 #?       {
 510 #?         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 511 #?         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 512 #?         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 513 #?         var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 514 #?         var cursor-word/ebx: (addr word) <- copy _cursor-word
 515 #?         print-string 0, "word at cursor after: "
 516 #?         print-word 0, cursor-word
 517 #?         print-string 0, "\n"
 518 #?       }
 519     }
 520     return
 521   }
 522   compare key, 0x435b1b/right-arrow
 523   $process-sandbox-edit:key-right-arrow: {
 524     break-if-!=
 525     # if not at end, move right within current word
 526     var at-end?/eax: boolean <- cursor-at-end? cursor-word
 527     compare at-end?, 0/false
 528     {
 529       break-if-!=
 530 #?       print-string 0, "a\n"
 531       cursor-right cursor-word
 532       return
 533     }
 534     # if at final word, look for a caller to jump to
 535     {
 536       var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 537       var next-word/eax: (addr word) <- lookup *next-word-ah
 538       compare next-word, 0
 539       break-if-!=
 540       var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 541       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 542       var next-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 543       var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
 544       compare next-cursor-element, 0
 545       break-if-=
 546       copy-object next-cursor-element-ah, cursor-call-path-ah
 547       return
 548     }
 549     # otherwise, move to the next word
 550     var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 551     var next-word/eax: (addr word) <- lookup *next-word-ah
 552     {
 553       compare next-word, 0
 554       break-if-=
 555 #?       print-string 0, "b\n"
 556       cursor-to-start next-word
 557       # . . cursor-word now out of date
 558       var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 559       increment-final-element cursor-call-path
 560       # Is the new cursor word expanded? If so, it's a function call. Add a
 561       # new level to the cursor-call-path for the call's body.
 562       $process-sandbox-edit:key-right-arrow-next-word-is-call-expanded: {
 563 #?         print-string 0, "c\n"
 564         {
 565           var expanded-words/eax: (addr handle call-path) <- get sandbox, expanded-words
 566           var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
 567           compare curr-word-is-expanded?, 0/false
 568           break-if-= $process-sandbox-edit:key-right-arrow-next-word-is-call-expanded
 569         }
 570         var callee-h: (handle function)
 571         var callee-ah/edx: (addr handle function) <- address callee-h
 572         var functions/ebx: (addr handle function) <- get self, functions
 573         callee functions, next-word, callee-ah
 574         var callee/eax: (addr function) <- lookup *callee-ah
 575         var callee-body-ah/eax: (addr handle line) <- get callee, body
 576         var callee-body/eax: (addr line) <- lookup *callee-body-ah
 577         var callee-body-first-word/edx: (addr handle word) <- get callee-body, data
 578         push-to-call-path-element cursor-call-path, callee-body-first-word
 579         # position cursor at left
 580         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 581         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 582         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 583         var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 584         cursor-to-start cursor-word
 585 #?         print-string 0, "d\n"
 586         return
 587       }
 588     }
 589     return
 590   }
 591   compare key, 0xa/enter
 592   {
 593     break-if-!=
 594     # toggle display of subsidiary stack
 595     toggle-cursor-word sandbox
 596     return
 597   }
 598   compare key, 0xc/ctrl-l
 599   $process-sandbox-edit:new-line: {
 600     break-if-!=
 601     # new line in sandbox
 602     append-line sandbox
 603     return
 604   }
 605   # word-based motions
 606   compare key, 2/ctrl-b
 607   $process-sandbox-edit:prev-word: {
 608     break-if-!=
 609     # jump to previous word at same level
 610     var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 611     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 612     {
 613       compare prev-word, 0
 614       break-if-=
 615       cursor-to-end prev-word
 616       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 617       decrement-final-element cursor-call-path
 618       return
 619     }
 620     # if previous word doesn't exist, try to bump up one level
 621     {
 622       var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 623       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 624       var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 625       var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah
 626       compare caller-cursor-element, 0
 627       break-if-=
 628       # check if previous word exists in caller
 629       var caller-word-ah/eax: (addr handle word) <- get caller-cursor-element, word
 630       var caller-word/eax: (addr word) <- lookup *caller-word-ah
 631       var word-before-caller-ah/eax: (addr handle word) <- get caller-word, prev
 632       var word-before-caller/eax: (addr word) <- lookup *word-before-caller-ah
 633       compare word-before-caller, 0
 634       break-if-=
 635       # if so jump to it
 636       drop-from-call-path-element cursor-call-path-ah
 637       decrement-final-element cursor-call-path-ah
 638       return
 639     }
 640   }
 641   compare key, 6/ctrl-f
 642   $process-sandbox-edit:next-word: {
 643     break-if-!=
 644 #?     print-string 0, "AA\n"
 645     # jump to previous word at same level
 646     var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 647     var next-word/eax: (addr word) <- lookup *next-word-ah
 648     {
 649       compare next-word, 0
 650       break-if-=
 651 #?       print-string 0, "BB\n"
 652       cursor-to-end next-word
 653       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 654       increment-final-element cursor-call-path
 655       return
 656     }
 657     # if next word doesn't exist, try to bump up one level
 658 #?     print-string 0, "CC\n"
 659     var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 660     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 661     var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 662     var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah
 663     compare caller-cursor-element, 0
 664     break-if-=
 665 #?     print-string 0, "DD\n"
 666     copy-object caller-cursor-element-ah, cursor-call-path-ah
 667     return
 668   }
 669   compare key, 7/ctrl-g
 670   $process-sandbox-edit:goto-function: {
 671     break-if-!=
 672     # initialize dialog to name function to jump to
 673     var partial-function-name-ah/eax: (addr handle word) <- get self, partial-function-name
 674     allocate partial-function-name-ah
 675     var partial-function-name/eax: (addr word) <- lookup *partial-function-name-ah
 676     initialize-word partial-function-name
 677     return
 678   }
 679   # line-based motions
 680   compare key, 1/ctrl-a
 681   $process-sandbox-edit:start-of-line: {
 682     break-if-!=
 683     # move cursor up past all calls and to start of line
 684     var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 685     drop-nested-calls cursor-call-path-ah
 686     move-final-element-to-start-of-line cursor-call-path-ah
 687     # move cursor to start of word
 688     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 689     var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 690     var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 691     cursor-to-start cursor-word
 692     # this works as long as the first word isn't expanded
 693     # but we don't expect to see zero-arg functions first-up
 694     return
 695   }
 696   compare key, 5/ctrl-e
 697   $process-sandbox-edit:end-of-line: {
 698     break-if-!=
 699     # move cursor up past all calls and to start of line
 700     var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 701     drop-nested-calls cursor-call-path-ah
 702     move-final-element-to-end-of-line cursor-call-path-ah
 703     # move cursor to end of word
 704     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 705     var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 706     var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 707     cursor-to-end cursor-word
 708     # this works because expanded words lie to the right of their bodies
 709     # so the final word is always guaranteed to be at the top-level
 710     return
 711   }
 712   compare key, 0x15/ctrl-u
 713   $process-sandbox-edit:clear-line: {
 714     break-if-!=
 715     # clear line in sandbox
 716     initialize-sandbox sandbox
 717     return
 718   }
 719   # if cursor is within a call, disable editing hotkeys below
 720   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 721   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 722   var next-cursor-element-ah/eax: (addr handle call-path-element) <- get cursor-call-path, next
 723   var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
 724   compare next-cursor-element, 0
 725   {
 726     break-if-=
 727     return
 728   }
 729   # - remaining keys only work at the top row outside any function calls
 730   compare key, 0x7f/del  # backspace on Macs
 731   $process-sandbox-edit:backspace: {
 732     break-if-!=
 733     # if not at start of some word, delete code-point-utf8 before cursor within current word
 734     var at-start?/eax: boolean <- cursor-at-start? cursor-word
 735     compare at-start?, 0/false
 736     {
 737       break-if-!=
 738       delete-before-cursor cursor-word
 739       return
 740     }
 741     # otherwise delete current word and move to end of prev word
 742     var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
 743     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 744     {
 745       compare prev-word, 0
 746       break-if-=
 747       cursor-to-end prev-word
 748       delete-next prev-word
 749       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 750       decrement-final-element cursor-call-path
 751     }
 752     return
 753   }
 754   compare key, 0x20/space
 755   $process-sandbox-edit:space: {
 756     break-if-!=
 757 #?     print-string 0, "space\n"
 758     # if cursor is at start of word, insert word before
 759     {
 760       var at-start?/eax: boolean <- cursor-at-start? cursor-word
 761       compare at-start?, 0/false
 762       break-if-=
 763       var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
 764       append-word prev-word-ah
 765       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 766       decrement-final-element cursor-call-path
 767       return
 768     }
 769     # if start of word is quote and code-point-utf8 before cursor is not, just insert it as usual
 770     # TODO: support string escaping
 771     {
 772       var first-code-point-utf8/eax: code-point-utf8 <- first-code-point-utf8 cursor-word
 773       compare first-code-point-utf8, 0x22/double-quote
 774       break-if-!=
 775       var final-code-point-utf8/eax: code-point-utf8 <- code-point-utf8-before-cursor cursor-word
 776       compare final-code-point-utf8, 0x22/double-quote
 777       break-if-=
 778       break $process-sandbox-edit:space
 779     }
 780     # if start of word is '[' and code-point-utf8 before cursor is not ']', just insert it as usual
 781     # TODO: support nested arrays
 782     {
 783       var first-code-point-utf8/eax: code-point-utf8 <- first-code-point-utf8 cursor-word
 784       compare first-code-point-utf8, 0x5b/[
 785       break-if-!=
 786       var final-code-point-utf8/eax: code-point-utf8 <- code-point-utf8-before-cursor cursor-word
 787       compare final-code-point-utf8, 0x5d/]
 788       break-if-=
 789       break $process-sandbox-edit:space
 790     }
 791     # otherwise insert word after and move cursor to it for the next key
 792     # (but we'll continue to track the current cursor-word for the rest of this function)
 793     append-word cursor-word-ah
 794     var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 795     increment-final-element cursor-call-path
 796     # if cursor is at end of word, that's all
 797     var at-end?/eax: boolean <- cursor-at-end? cursor-word
 798     compare at-end?, 0/false
 799     {
 800       break-if-=
 801       return
 802     }
 803     # otherwise we're in the middle of a word
 804     # move everything after cursor to the (just created) next word
 805     var next-word-ah/eax: (addr handle word) <- get cursor-word, next
 806     var _next-word/eax: (addr word) <- lookup *next-word-ah
 807     var next-word/ebx: (addr word) <- copy _next-word
 808     {
 809       var at-end?/eax: boolean <- cursor-at-end? cursor-word
 810       compare at-end?, 0/false
 811       break-if-!=
 812       var g/eax: code-point-utf8 <- pop-after-cursor cursor-word
 813       add-code-point-utf8-to-word next-word, g
 814       loop
 815     }
 816     cursor-to-start next-word
 817     return
 818   }
 819   compare key, 0xe/ctrl-n
 820   $process:rename-word: {
 821     break-if-!=
 822     # TODO: ensure current word is not a function
 823     # rename word at cursor
 824     var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 825     allocate new-name-ah
 826     var new-name/eax: (addr word) <- lookup *new-name-ah
 827     initialize-word new-name
 828     return
 829   }
 830   compare key, 4/ctrl-d
 831   $process:define-function: {
 832     break-if-!=
 833     # define function out of line at cursor
 834     var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-function
 835     allocate new-name-ah
 836     var new-name/eax: (addr word) <- lookup *new-name-ah
 837     initialize-word new-name
 838     return
 839   }
 840   # otherwise insert key within current word
 841   var g/edx: code-point-utf8 <- copy key
 842   var print?/eax: boolean <- real-code-point-utf8? key
 843   $process-sandbox-edit:real-code-point-utf8: {
 844     compare print?, 0/false
 845     break-if-=
 846     add-code-point-utf8-to-word cursor-word, g
 847     return
 848   }
 849   # silently ignore other hotkeys
 850 }
 851 
 852 # collect new name in partial-name-for-cursor-word, and then rename the word
 853 # at cursor to it
 854 # Precondition: cursor-call-path is a singleton (not within a call)
 855 fn process-sandbox-rename _sandbox: (addr sandbox), key: code-point-utf8 {
 856   var sandbox/esi: (addr sandbox) <- copy _sandbox
 857   var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 858   # if 'esc' pressed, cancel rename
 859   compare key, 0x1b/esc
 860   $process-sandbox-rename:cancel: {
 861     break-if-!=
 862     clear-object new-name-ah
 863     return
 864   }
 865   # if 'enter' pressed, perform rename
 866   compare key, 0xa/enter
 867   $process-sandbox-rename:commit: {
 868     break-if-!=
 869 #?     print-string 0, "rename\n"
 870     # new line
 871     var new-line-h: (handle line)
 872     var new-line-ah/eax: (addr handle line) <- address new-line-h
 873     allocate new-line-ah
 874     var new-line/eax: (addr line) <- lookup *new-line-ah
 875     initialize-line new-line
 876     var new-line-word-ah/ecx: (addr handle word) <- get new-line, data
 877     {
 878       # move word at cursor to new line
 879       var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 880       var cursor/eax: (addr call-path-element) <- lookup *cursor-ah
 881       var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
 882 #?       print-string 0, "cursor before at word "
 883 #?       {
 884 #?         var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 885 #?         print-word 0, cursor-word
 886 #?         print-string 0, "\n"
 887 #?       }
 888       move-word-contents word-at-cursor-ah, new-line-word-ah
 889       # copy name to word at cursor
 890       copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah
 891 #?       print-string 0, "cursor after at word "
 892 #?       {
 893 #?         var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 894 #?         print-word 0, cursor-word
 895 #?         print-string 0, "\n"
 896 #?         var foo/eax: int <- copy cursor-word
 897 #?         print-int32-hex 0, foo
 898 #?         print-string 0, "\n"
 899 #?       }
 900 #?       print-string 0, "new name word "
 901 #?       {
 902 #?         var new-name/eax: (addr word) <- lookup *new-name-ah
 903 #?         print-word 0, new-name
 904 #?         print-string 0, "\n"
 905 #?         var foo/eax: int <- copy new-name
 906 #?         print-int32-hex 0, foo
 907 #?         print-string 0, "\n"
 908 #?       }
 909     }
 910     # prepend '=' to name
 911     {
 912       var new-name/eax: (addr word) <- lookup *new-name-ah
 913       cursor-to-start new-name
 914       add-code-point-utf8-to-word new-name, 0x3d/=
 915     }
 916     # append name to new line
 917     chain-words new-line-word-ah, new-name-ah
 918     # new-line->next = sandbox->data
 919     var new-line-next/ecx: (addr handle line) <- get new-line, next
 920     var sandbox-slot/edx: (addr handle line) <- get sandbox, data
 921     copy-object sandbox-slot, new-line-next
 922     # sandbox->data = new-line
 923     copy-handle new-line-h, sandbox-slot
 924     # clear partial-name-for-cursor-word
 925     clear-object new-name-ah
 926 #?     var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 927 #?     var cursor/eax: (addr call-path-element) <- lookup *cursor-ah
 928 #?     var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
 929 #?     print-string 0, "cursor after rename: "
 930 #?     {
 931 #?       var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 932 #?       print-word 0, cursor-word
 933 #?       print-string 0, " -- "
 934 #?       var foo/eax: int <- copy cursor-word
 935 #?       print-int32-hex 0, foo
 936 #?       print-string 0, "\n"
 937 #?     }
 938     return
 939   }
 940   #
 941   compare key, 0x7f/del  # backspace on Macs
 942   $process-sandbox-rename:backspace: {
 943     break-if-!=
 944     # if not at start, delete code-point-utf8 before cursor
 945     var new-name/eax: (addr word) <- lookup *new-name-ah
 946     var at-start?/eax: boolean <- cursor-at-start? new-name
 947     compare at-start?, 0/false
 948     {
 949       break-if-!=
 950       var new-name/eax: (addr word) <- lookup *new-name-ah
 951       delete-before-cursor new-name
 952     }
 953     return
 954   }
 955   # otherwise insert key within current word
 956   var print?/eax: boolean <- real-code-point-utf8? key
 957   $process-sandbox-rename:real-code-point-utf8: {
 958     compare print?, 0/false
 959     break-if-=
 960     var new-name/eax: (addr word) <- lookup *new-name-ah
 961     add-code-point-utf8-to-word new-name, key
 962     return
 963   }
 964   # silently ignore other hotkeys
 965 }
 966 
 967 # collect new name in partial-name-for-function, and then define the last line
 968 # of the sandbox to be a new function with that name. Replace the last line
 969 # with a call to the appropriate function.
 970 # Precondition: cursor-call-path is a singleton (not within a call)
 971 fn process-sandbox-define _sandbox: (addr sandbox), functions: (addr handle function), key: code-point-utf8 {
 972   var sandbox/esi: (addr sandbox) <- copy _sandbox
 973   var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-function
 974   # if 'esc' pressed, cancel define
 975   compare key, 0x1b/esc
 976   $process-sandbox-define:cancel: {
 977     break-if-!=
 978     clear-object new-name-ah
 979     return
 980   }
 981   # if 'enter' pressed, perform define
 982   compare key, 0xa/enter
 983   $process-sandbox-define:commit: {
 984     break-if-!=
 985 #?     print-string 0, "define\n"
 986     # create new function
 987     var new-function: (handle function)
 988     var new-function-ah/ecx: (addr handle function) <- address new-function
 989     allocate new-function-ah
 990     var _new-function/eax: (addr function) <- lookup *new-function-ah
 991     var new-function/ebx: (addr function) <- copy _new-function
 992     var dest/edx: (addr handle function) <- get new-function, next
 993     copy-object functions, dest
 994     copy-object new-function-ah, functions
 995     # set function name to new-name
 996     var new-name/eax: (addr word) <- lookup *new-name-ah
 997     var dest/edx: (addr handle array byte) <- get new-function, name
 998     word-to-string new-name, dest
 999     # move final line to body
1000     var body-ah/eax: (addr handle line) <- get new-function, body
1001     allocate body-ah
1002     var body/eax: (addr line) <- lookup *body-ah
1003     var body-contents/ecx: (addr handle word) <- get body, data
1004     var final-line-storage: (handle line)
1005     var final-line-ah/eax: (addr handle line) <- address final-line-storage
1006     final-line sandbox, final-line-ah
1007     var final-line/eax: (addr line) <- lookup *final-line-ah
1008     var final-line-contents/eax: (addr handle word) <- get final-line, data
1009     copy-object final-line-contents, body-contents
1010     var cursor-word-ah/ecx: (addr handle word) <- get new-function, cursor-word
1011     copy-object final-line-contents, cursor-word-ah
1012     {
1013       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
1014       cursor-to-start cursor-word
1015     }
1016     #
1017     copy-unbound-words-to-args functions
1018     #
1019     var empty-word: (handle word)
1020     copy-handle empty-word, final-line-contents
1021     construct-call functions, final-line-contents
1022     # clear partial-name-for-function
1023     var empty-word: (handle word)
1024     copy-handle empty-word, new-name-ah
1025     # update cursor
1026     var final-line/eax: (addr line) <- lookup final-line-storage
1027     var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
1028     allocate cursor-call-path-ah  # leak
1029     initialize-path-from-line final-line, cursor-call-path-ah
1030     return
1031   }
1032   #
1033   compare key, 0x7f/del  # backspace on Macs
1034   $process-sandbox-define:backspace: {
1035     break-if-!=
1036     # if not at start, delete code-point-utf8 before cursor
1037     var new-name/eax: (addr word) <- lookup *new-name-ah
1038     var at-start?/eax: boolean <- cursor-at-start? new-name
1039     compare at-start?, 0/false
1040     {
1041       break-if-!=
1042       var new-name/eax: (addr word) <- lookup *new-name-ah
1043       delete-before-cursor new-name
1044     }
1045     return
1046   }
1047   # otherwise insert key within current word
1048   var print?/eax: boolean <- real-code-point-utf8? key
1049   $process-sandbox-define:real-code-point-utf8: {
1050     compare print?, 0/false
1051     break-if-=
1052     var new-name/eax: (addr word) <- lookup *new-name-ah
1053     add-code-point-utf8-to-word new-name, key
1054     return
1055   }
1056   # silently ignore other hotkeys
1057 }
1058 
1059 # extract from the body of the first function in 'functions' all words that
1060 # aren't defined in the rest of 'functions'. Prepend them in reverse order.
1061 # Assumes function body is a single line for now.
1062 fn copy-unbound-words-to-args _functions: (addr handle function) {
1063   # target
1064   var target-ah/eax: (addr handle function) <- copy _functions
1065   var _target/eax: (addr function) <- lookup *target-ah
1066   var target/esi: (addr function) <- copy _target
1067   var dest-ah/edi: (addr handle word) <- get target, args
1068   # next
1069   var functions-ah/edx: (addr handle function) <- get target, next
1070   # src
1071   var line-ah/eax: (addr handle line) <- get target, body
1072   var line/eax: (addr line) <- lookup *line-ah
1073   var curr-ah/eax: (addr handle word) <- get line, data
1074   var curr/eax: (addr word) <- lookup *curr-ah
1075   {
1076     compare curr, 0
1077     break-if-=
1078     $copy-unbound-words-to-args:loop-iter: {
1079       # is it a number?
1080       {
1081         var int?/eax: boolean <- word-is-decimal-integer? curr
1082         compare int?, 0/false
1083         break-if-!= $copy-unbound-words-to-args:loop-iter
1084       }
1085       # is it a pre-existing function?
1086       var bound?/ebx: boolean <- bound-function? curr, functions-ah
1087       compare bound?, 0/false
1088       break-if-!=
1089       # is it already bound as an arg?
1090       var dup?/ebx: boolean <- arg-exists? _functions, curr  # _functions = target-ah
1091       compare dup?, 0/false
1092       break-if-!= $copy-unbound-words-to-args:loop-iter
1093       # push copy of curr before dest-ah
1094       var rest-h: (handle word)
1095       var rest-ah/ecx: (addr handle word) <- address rest-h
1096       copy-object dest-ah, rest-ah
1097       copy-word curr, dest-ah
1098       chain-words dest-ah, rest-ah
1099     }
1100     var next-ah/ecx: (addr handle word) <- get curr, next
1101     curr <- lookup *next-ah
1102     loop
1103   }
1104 }
1105 
1106 fn bound-function? w: (addr word), functions-ah: (addr handle function) -> _/ebx: boolean {
1107   var result/ebx: boolean <- copy 1/true
1108   {
1109     ## numbers
1110     # if w == "+" return true
1111     var subresult/eax: boolean <- word-equal? w, "+"
1112     compare subresult, 0/false
1113     break-if-!=
1114     # if w == "-" return true
1115     subresult <- word-equal? w, "-"
1116     compare subresult, 0/false
1117     break-if-!=
1118     # if w == "*" return true
1119     subresult <- word-equal? w, "*"
1120     compare subresult, 0/false
1121     break-if-!=
1122     # if w == "/" return true
1123     subresult <- word-equal? w, "/"
1124     compare subresult, 0/false
1125     break-if-!=
1126     # if w == "sqrt" return true
1127     subresult <- word-equal? w, "sqrt"
1128     compare subresult, 0/false
1129     break-if-!=
1130     ## strings/arrays
1131     # if w == "len" return true
1132     subresult <- word-equal? w, "len"
1133     compare subresult, 0/false
1134     break-if-!=
1135     ## files
1136     # if w == "open" return true
1137     subresult <- word-equal? w, "open"
1138     compare subresult, 0/false
1139     break-if-!=
1140     # if w == "read" return true
1141     subresult <- word-equal? w, "read"
1142     compare subresult, 0/false
1143     break-if-!=
1144     # if w == "slurp" return true
1145     subresult <- word-equal? w, "slurp"
1146     compare subresult, 0/false
1147     break-if-!=
1148     # if w == "lines" return true
1149     subresult <- word-equal? w, "lines"
1150     compare subresult, 0/false
1151     break-if-!=
1152     ## screens
1153     # if w == "fake-screen" return true
1154     subresult <- word-equal? w, "fake-screen"
1155     compare subresult, 0/false
1156     break-if-!=
1157     # if w == "print" return true
1158     subresult <- word-equal? w, "print"
1159     compare subresult, 0/false
1160     break-if-!=
1161     # if w == "move" return true
1162     subresult <- word-equal? w, "move"
1163     compare subresult, 0/false
1164     break-if-!=
1165     # if w == "up" return true
1166     subresult <- word-equal? w, "up"
1167     compare subresult, 0/false
1168     break-if-!=
1169     # if w == "down" return true
1170     subresult <- word-equal? w, "down"
1171     compare subresult, 0/false
1172     break-if-!=
1173     # if w == "left" return true
1174     subresult <- word-equal? w, "left"
1175     compare subresult, 0/false
1176     break-if-!=
1177     # if w == "right" return true
1178     subresult <- word-equal? w, "right"
1179     compare subresult, 0/false
1180     break-if-!=
1181     ## hacks
1182     # if w == "dup" return true
1183     subresult <- word-equal? w, "dup"
1184     compare subresult, 0/false
1185     break-if-!=
1186     # if w == "swap" return true
1187     subresult <- word-equal? w, "swap"
1188     compare subresult, 0/false
1189     break-if-!=
1190     # return w in functions
1191     var out-h: (handle function)
1192     var out/eax: (addr handle function) <- address out-h
1193     callee functions-ah, w, out
1194     var found?/eax: (addr function) <- lookup *out
1195     result <- copy found?
1196   }
1197   return result
1198 }
1199 
1200 fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> _/ebx: boolean {
1201   var f-ah/eax: (addr handle function) <- copy _f-ah
1202   var f/eax: (addr function) <- lookup *f-ah
1203   var args-ah/eax: (addr handle word) <- get f, args
1204   var result/ebx: boolean <- word-exists? args-ah, arg
1205   return result
1206 }
1207 
1208 # construct a call to `f` with copies of exactly its args
1209 fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) {
1210   var f-ah/eax: (addr handle function) <- copy _f-ah
1211   var _f/eax: (addr function) <- lookup *f-ah
1212   var f/esi: (addr function) <- copy _f
1213   # append args in reverse
1214   var args-ah/eax: (addr handle word) <- get f, args
1215   var dest-ah/edi: (addr handle word) <- copy _dest-ah
1216   copy-words-in-reverse args-ah, dest-ah
1217   # append name
1218   var name-ah/eax: (addr handle array byte) <- get f, name
1219   var name/eax: (addr array byte) <- lookup *name-ah
1220   append-word-at-end-with dest-ah, name
1221 }
1222 
1223 fn word-index _words: (addr handle word), _n: int, out: (addr handle word) {
1224   var n/ecx: int <- copy _n
1225   {
1226     compare n, 0
1227     break-if-!=
1228     copy-object _words, out
1229     return
1230   }
1231   var words-ah/eax: (addr handle word) <- copy _words
1232   var words/eax: (addr word) <- lookup *words-ah
1233   var next/eax: (addr handle word) <- get words, next
1234   n <- decrement
1235   word-index next, n, out
1236 }
1237 
1238 fn toggle-cursor-word _sandbox: (addr sandbox) {
1239   var sandbox/esi: (addr sandbox) <- copy _sandbox
1240   var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
1241   var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
1242 #?   print-string 0, "cursor call path: "
1243 #?   dump-call-path-element 0, cursor-call-path
1244 #?   print-string 0, "expanded words:\n"
1245 #?   dump-call-paths 0, expanded-words
1246   var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
1247   compare already-expanded?, 0/false
1248   {
1249     break-if-!=
1250 #?     print-string 0, "expand\n"
1251     # if not already-expanded, insert
1252     insert-in-call-path expanded-words cursor-call-path
1253 #?     print-string 0, "expanded words now:\n"
1254 #?     dump-call-paths 0, expanded-words
1255     return
1256   }
1257   {
1258     break-if-=
1259     # otherwise delete
1260     delete-in-call-path expanded-words cursor-call-path
1261   }
1262 }
1263 
1264 fn append-line _sandbox: (addr sandbox) {
1265   var sandbox/esi: (addr sandbox) <- copy _sandbox
1266   var line-ah/ecx: (addr handle line) <- get sandbox, data
1267   {
1268     var line/eax: (addr line) <- lookup *line-ah
1269     var next-line-ah/edx: (addr handle line) <- get line, next
1270     var next-line/eax: (addr line) <- lookup *next-line-ah
1271     compare next-line, 0
1272     break-if-=
1273     line-ah <- copy next-line-ah
1274     loop
1275   }
1276   var line/eax: (addr line) <- lookup *line-ah
1277   var final-line-ah/edx: (addr handle line) <- get line, next
1278   allocate final-line-ah
1279   var final-line/eax: (addr line) <- lookup *final-line-ah
1280   initialize-line final-line
1281   var final-prev/eax: (addr handle line) <- get final-line, prev
1282   copy-object line-ah, final-prev
1283   # clear cursor
1284   var final-line/eax: (addr line) <- lookup *final-line-ah
1285   var word-ah/ecx: (addr handle word) <- get final-line, data
1286   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
1287   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
1288   var dest/eax: (addr handle word) <- get cursor-call-path, word
1289   copy-object word-ah, dest
1290 }
1291 
1292 #############
1293 # Visualize
1294 #############
1295 
1296 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) {
1297   var env/esi: (addr environment) <- copy _env
1298   # functions
1299   var functions/edx: (addr handle function) <- get env, functions
1300   # line
1301   var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes
1302   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
1303   var line-ah/eax: (addr handle line) <- get sandbox, data
1304   var _line/eax: (addr line) <- lookup *line-ah
1305   var line/esi: (addr line) <- copy _line
1306   evaluate functions, 0, line, 0, stack
1307 }
1308 
1309 fn render _env: (addr environment) {
1310 #?   print-string 0, "== render\n"
1311   var env/esi: (addr environment) <- copy _env
1312   clear-canvas env
1313   # menu
1314   render-menu env
1315   # screen
1316   var screen-ah/eax: (addr handle screen) <- get env, screen
1317   var _screen/eax: (addr screen) <- lookup *screen-ah
1318   var screen/edi: (addr screen) <- copy _screen
1319   # functions
1320   var sep-col/eax: (addr int) <- get env, code-separator-col
1321   var functions/edx: (addr handle function) <- get env, functions
1322   render-functions screen, *sep-col, env
1323   # sandbox
1324   var repl-col/ecx: int <- copy *sep-col
1325   repl-col <- add 2/repl-margin-left
1326   var cursor-sandbox-ah/eax: (addr handle sandbox) <- get env, cursor-sandbox
1327   var cursor-sandbox/eax: (addr sandbox) <- lookup *cursor-sandbox-ah
1328   # bindings
1329   var bindings-storage: table
1330   var bindings/ebx: (addr table) <- address bindings-storage
1331   initialize-table bindings, 0x10
1332 #?   print-string 0, "render-sandbox {\n"
1333   render-sandbox screen, functions, bindings, cursor-sandbox, 3, repl-col
1334 #?   print-string 0, "render-sandbox }\n"
1335   # dialogs
1336   render-goto-dialog screen, env
1337   #
1338   position-cursor screen, env
1339 }
1340 
1341 # draw a wordstar-style cheatsheet of shortcuts on the bottom line of the screen
1342 fn render-menu _env: (addr environment) {
1343   var env/esi: (addr environment) <- copy _env
1344   var cursor-function-ah/eax: (addr handle function) <- get env, cursor-function
1345   var cursor-function/eax: (addr function) <- lookup *cursor-function-ah
1346   {
1347     compare cursor-function, 0
1348     break-if-=
1349     render-function-menu env
1350     return
1351   }
1352   var cursor-sandbox-ah/eax: (addr handle sandbox) <- get env, cursor-sandbox
1353   var cursor-sandbox/eax: (addr sandbox) <- lookup *cursor-sandbox-ah
1354   {
1355     compare cursor-sandbox, 0
1356     break-if-=
1357     render-sandbox-menu env
1358     return
1359   }
1360 }
1361 
1362 # HACK: areas currently responsible for positioning their dialogs' cursors. So
1363 # we just do nothing here if a dialog is up.
1364 fn position-cursor screen: (addr screen), _env: (addr environment) {
1365   var env/esi: (addr environment) <- copy _env
1366   var goto-function-ah/eax: (addr handle word) <- get env, partial-function-name
1367   var goto-function/eax: (addr word) <- lookup *goto-function-ah
1368   {
1369     compare goto-function, 0
1370     break-if-=
1371     return
1372   }
1373   var cursor-function-ah/eax: (addr handle function) <- get env, cursor-function
1374   var cursor-function/eax: (addr function) <- lookup *cursor-function-ah
1375   {
1376     compare cursor-function, 0
1377     break-if-=
1378     var cursor-row/ecx: (addr int) <- get cursor-function, cursor-row
1379     var cursor-col/eax: (addr int) <- get cursor-function, cursor-col
1380     move-cursor screen, *cursor-row, *cursor-col
1381     return
1382   }
1383   var cursor-sandbox-ah/eax: (addr handle sandbox) <- get env, cursor-sandbox
1384   var cursor-sandbox/eax: (addr sandbox) <- lookup *cursor-sandbox-ah
1385   {
1386     compare cursor-sandbox, 0
1387     break-if-=
1388     # if in a dialog, return
1389     {
1390       var partial-word-rename-ah/eax: (addr handle word) <- get cursor-sandbox, partial-name-for-cursor-word
1391       var partial-word-rename/eax: (addr word) <- lookup *partial-word-rename-ah
1392       compare partial-word-rename, 0
1393       break-if-=
1394       return
1395     }
1396     {
1397       var partial-function-name-ah/eax: (addr handle word) <- get cursor-sandbox, partial-name-for-function
1398       var partial-function-name/eax: (addr word) <- lookup *partial-function-name-ah
1399       compare partial-function-name, 0
1400       break-if-=
1401       return
1402     }
1403     var cursor-row/ecx: (addr int) <- get cursor-sandbox, cursor-row
1404     var cursor-col/eax: (addr int) <- get cursor-sandbox, cursor-col
1405     move-cursor screen, *cursor-row, *cursor-col
1406   }
1407 }
1408 
1409 fn render-goto-dialog screen: (addr screen), _env: (addr environment) {
1410   var env/esi: (addr environment) <- copy _env
1411   var goto-function-mode-ah?/eax: (addr handle word) <- get env, partial-function-name
1412   var goto-function-mode?/eax: (addr word) <- lookup *goto-function-mode-ah?
1413   compare goto-function-mode?, 0/false
1414   break-if-=
1415   # clear a space for the dialog
1416   var top-row/ebx: int <- copy 3
1417   var bottom-row/edx: int <- copy 9
1418   var sep-col/eax: (addr int) <- get env, code-separator-col
1419   var left-col/ecx: int <- copy *sep-col
1420   left-col <- subtract 0x10
1421   var right-col/eax: int <- copy *sep-col
1422   right-col <- add 0x10
1423   clear-rect screen, top-row, left-col, bottom-row, right-col
1424   draw-box screen, top-row, left-col, bottom-row, right-col
1425   # render a little menu for the dialog
1426   var menu-row/eax: int <- copy bottom-row
1427   menu-row <- decrement
1428   var menu-col/edx: int <- copy left-col
1429   menu-col <- add 2
1430   move-cursor screen, menu-row, menu-col
1431   start-reverse-video screen
1432   print-string screen, " esc "
1433   reset-formatting screen
1434   print-string screen, " cancel  "
1435   start-reverse-video screen
1436   print-string screen, " enter "
1437   reset-formatting screen
1438   print-string screen, " jump  "
1439   # draw the word, positioned appropriately around the cursor
1440   var start-col/ecx: int <- copy left-col
1441   start-col <- increment
1442   move-cursor screen, 6, start-col  # cursor-row
1443   var word-ah?/edx: (addr handle word) <- get env, partial-function-name
1444   var word/eax: (addr word) <- lookup *word-ah?
1445   print-word screen, word
1446 }
1447 
1448 fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int {
1449   var sandbox/esi: (addr sandbox) <- copy _sandbox
1450   # line
1451   var curr-line-ah/eax: (addr handle line) <- get sandbox, data
1452   var _curr-line/eax: (addr line) <- lookup *curr-line-ah
1453   var curr-line/ecx: (addr line) <- copy _curr-line
1454   #
1455   var curr-row/edx: int <- copy top-row
1456   # cursor row, col
1457   var cursor-row-addr: (addr int)
1458   var tmp/eax: (addr int) <- get sandbox, cursor-row
1459   copy-to cursor-row-addr, tmp
1460   var cursor-col-addr: (addr int)
1461   tmp <- get sandbox, cursor-col
1462   copy-to cursor-col-addr, tmp
1463   # render all but final line without stack
1464 #?   print-string 0, "render all but final line\n"
1465   {
1466     var next-line-ah/eax: (addr handle line) <- get curr-line, next
1467     var next-line/eax: (addr line) <- lookup *next-line-ah
1468     compare next-line, 0
1469     break-if-=
1470     {
1471       var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
1472       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
1473       var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
1474       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
1475       # it's enough to pass in the first word of the path, because if the path isn't a singleton the word is guaranteed to be unique
1476       render-line-without-stack screen, curr-line, curr-row, left-col, cursor-word, cursor-row-addr, cursor-col-addr
1477     }
1478     curr-line <- copy next-line
1479     curr-row <- add 2
1480     loop
1481   }
1482   #
1483   render-final-line-with-stack screen, functions, bindings, sandbox, curr-row, left-col, cursor-row-addr, cursor-col-addr
1484   # at most one of the following dialogs will be rendered
1485   render-rename-dialog screen, sandbox
1486   render-define-dialog screen, sandbox
1487 }
1488 
1489 fn render-final-line-with-stack screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int, cursor-row-addr: (addr int), cursor-col-addr: (addr int) {
1490   var sandbox/esi: (addr sandbox) <- copy _sandbox
1491   # expanded-words
1492   var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
1493   # cursor-word
1494   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
1495   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
1496   var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
1497   var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
1498   var cursor-word/ebx: (addr word) <- copy _cursor-word
1499 #?   print-string 0, "word at cursor: "
1500 #?   print-word 0, cursor-word
1501 #?   print-string 0, "\n"
1502   # cursor-call-path
1503   var cursor-call-path: (addr handle call-path-element)
1504   {
1505     var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
1506     copy-to cursor-call-path, src
1507   }
1508   # first line
1509   var first-line-ah/eax: (addr handle line) <- get sandbox, data
1510   var _first-line/eax: (addr line) <- lookup *first-line-ah
1511   var first-line/edx: (addr line) <- copy _first-line
1512   # final line
1513   var final-line-storage: (handle line)
1514   var final-line-ah/eax: (addr handle line) <- address final-line-storage
1515   final-line sandbox, final-line-ah
1516   var final-line/eax: (addr line) <- lookup *final-line-ah
1517   # curr-path
1518   var curr-path-storage: (handle call-path-element)
1519   var curr-path/ecx: (addr handle call-path-element) <- address curr-path-storage
1520   allocate curr-path  # leak
1521   initialize-path-from-line final-line, curr-path
1522   #
1523   var dummy/ecx: int <- render-line screen, functions, bindings, first-line, final-line, expanded-words, top-row, left-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr
1524 }
1525 
1526 fn final-line _sandbox: (addr sandbox), out: (addr handle line) {
1527   var sandbox/esi: (addr sandbox) <- copy _sandbox
1528   var curr-line-ah/ecx: (addr handle line) <- get sandbox, data
1529   {
1530     var curr-line/eax: (addr line) <- lookup *curr-line-ah
1531     var next-line-ah/edx: (addr handle line) <- get curr-line, next
1532     var next-line/eax: (addr line) <- lookup *next-line-ah
1533     compare next-line, 0
1534     break-if-=
1535     curr-line-ah <- copy next-line-ah
1536     loop
1537   }
1538   copy-object curr-line-ah, out
1539 }
1540 
1541 fn render-rename-dialog screen: (addr screen), _sandbox: (addr sandbox) {
1542   var sandbox/edi: (addr sandbox) <- copy _sandbox
1543   var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
1544   var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah?
1545   compare rename-word-mode?, 0/false
1546   break-if-=
1547   # clear a space for the dialog
1548   var cursor-row/ebx: (addr int) <- get sandbox, cursor-row
1549   var top-row/eax: int <- copy *cursor-row
1550   top-row <- subtract 3
1551   var bottom-row/ecx: int <- copy *cursor-row
1552   bottom-row <- add 3
1553   var cursor-col/ebx: (addr int) <- get sandbox, cursor-col
1554   var left-col/edx: int <- copy *cursor-col
1555   left-col <- subtract 0x10
1556   var right-col/ebx: int <- copy *cursor-col
1557   right-col <- add 0x10
1558   clear-rect screen, top-row, left-col, bottom-row, right-col
1559   draw-box screen, top-row, left-col, bottom-row, right-col
1560   # render a little menu for the dialog
1561   var menu-row/ecx: int <- copy bottom-row
1562   menu-row <- decrement
1563   var menu-col/edx: int <- copy left-col
1564   menu-col <- add 2
1565   move-cursor screen, menu-row, menu-col
1566   start-reverse-video screen
1567   print-string screen, " esc "
1568   reset-formatting screen
1569   print-string screen, " cancel  "
1570   start-reverse-video screen
1571   print-string screen, " enter "
1572   reset-formatting screen
1573   print-string screen, " rename  "
1574   # draw the word, positioned appropriately around the cursor
1575   var cursor-col/ebx: (addr int) <- get sandbox, cursor-col
1576   var start-col/ecx: int <- copy *cursor-col
1577   var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
1578   var word/eax: (addr word) <- lookup *word-ah?
1579   var cursor-index/eax: int <- cursor-index word
1580   start-col <- subtract cursor-index
1581   var cursor-row/ebx: (addr int) <- get sandbox, cursor-row
1582   move-cursor screen, *cursor-row, start-col
1583   var word/eax: (addr word) <- lookup *word-ah?
1584   print-word screen, word
1585 }
1586 
1587 fn render-define-dialog screen: (addr screen), _sandbox: (addr sandbox) {
1588   var sandbox/edi: (addr sandbox) <- copy _sandbox
1589   var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function
1590   var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah?
1591   compare define-function-mode?, 0/false
1592   break-if-=
1593   # clear a space for the dialog
1594   var cursor-row/ebx: (addr int) <- get sandbox, cursor-row
1595   var top-row/eax: int <- copy *cursor-row
1596   top-row <- subtract 3
1597   var bottom-row/ecx: int <- copy *cursor-row
1598   bottom-row <- add 3
1599   var cursor-col/ebx: (addr int) <- get sandbox, cursor-col
1600   var left-col/edx: int <- copy *cursor-col
1601   left-col <- subtract 0x10
1602   var right-col/ebx: int <- copy *cursor-col
1603   right-col <- add 0x10
1604   clear-rect screen, top-row, left-col, bottom-row, right-col
1605   draw-box screen, top-row, left-col, bottom-row, right-col
1606   # render a little menu for the dialog
1607   var menu-row/ecx: int <- copy bottom-row
1608   menu-row <- decrement
1609   var menu-col/edx: int <- copy left-col
1610   menu-col <- add 2
1611   move-cursor screen, menu-row, menu-col
1612   start-reverse-video screen
1613   print-string screen, " esc "
1614   reset-formatting screen
1615   print-string screen, " cancel  "
1616   start-reverse-video screen
1617   print-string screen, " enter "
1618   reset-formatting screen
1619   print-string screen, " define  "
1620   # draw the word, positioned appropriately around the cursor
1621   var cursor-col/ebx: (addr int) <- get sandbox, cursor-col
1622   var start-col/ecx: int <- copy *cursor-col
1623   var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function
1624   var word/eax: (addr word) <- lookup *word-ah?
1625   var cursor-index/eax: int <- cursor-index word
1626   start-col <- subtract cursor-index
1627   var cursor-row/ebx: (addr int) <- get sandbox, cursor-row
1628   move-cursor screen, *cursor-row, start-col
1629   var word/eax: (addr word) <- lookup *word-ah?
1630   print-word screen, word
1631 }
1632 
1633 # Render just the words in 'line'.
1634 fn render-line-without-stack screen: (addr screen), _line: (addr line), curr-row: int, left-col: int, cursor-word: (addr word), cursor-row-addr: (addr int), cursor-col-addr: (addr int) {
1635   # curr-word
1636   var line/eax: (addr line) <- copy _line
1637   var first-word-ah/eax: (addr handle word) <- get line, data
1638   var _curr-word/eax: (addr word) <- lookup *first-word-ah
1639   var curr-word/esi: (addr word) <- copy _curr-word
1640   #
1641   # loop-carried dependency
1642   var curr-col/ecx: int <- copy left-col
1643   #
1644   {
1645     compare curr-word, 0
1646     break-if-=
1647 #?     print-string 0, "-- word in penultimate lines: "
1648 #?     {
1649 #?       var foo/eax: int <- copy curr-word
1650 #?       print-int32-hex 0, foo
1651 #?     }
1652 #?     print-string 0, "\n"
1653     var old-col/edx: int <- copy curr-col
1654     move-cursor screen, curr-row, curr-col
1655     print-word screen, curr-word
1656     {
1657       var max-width/eax: int <- word-length curr-word
1658       curr-col <- add max-width
1659       curr-col <- add 1/margin-right
1660     }
1661     # cache cursor column if necessary
1662     {
1663       compare curr-word, cursor-word
1664       break-if-!=
1665 #?       print-string 0, "Cursor at "
1666 #?       print-int32-decimal 0, curr-row
1667 #?       print-string 0, ", "
1668 #?       print-int32-decimal 0, old-col
1669 #?       print-string 0, "\n"
1670 #?       print-string 0, "contents: "
1671 #?       print-word 0, cursor-word
1672 #?       print-string 0, "\n"
1673 #?       {
1674 #?         var foo/eax: int <- copy cursor-word
1675 #?         print-int32-hex 0, foo
1676 #?         print-string 0, "\n"
1677 #?       }
1678       var dest/ecx: (addr int) <- copy cursor-row-addr
1679       var src/eax: int <- copy curr-row
1680       copy-to *dest, src
1681       dest <- copy cursor-col-addr
1682       copy-to *dest, old-col
1683       var cursor-index-in-word/eax: int <- cursor-index curr-word
1684       add-to *dest, cursor-index-in-word
1685     }
1686     # loop update
1687     var next-word-ah/edx: (addr handle word) <- get curr-word, next
1688     var _curr-word/eax: (addr word) <- lookup *next-word-ah
1689     curr-word <- copy _curr-word
1690     loop
1691   }
1692 }
1693 
1694 fn call-depth-at-cursor _sandbox: (addr sandbox) -> _/eax: int {
1695   var sandbox/esi: (addr sandbox) <- copy _sandbox
1696   var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
1697   var result/eax: int <- call-path-element-length cursor-call-path
1698   result <- add 2  # input-row - 1
1699   return result
1700 }
1701 
1702 fn call-path-element-length _x: (addr handle call-path-element) -> _/eax: int {
1703   var curr-ah/ecx: (addr handle call-path-element) <- copy _x
1704   var result/edi: int <- copy 0
1705   {
1706     var curr/eax: (addr call-path-element) <- lookup *curr-ah
1707     compare curr, 0
1708     break-if-=
1709     curr-ah <- get curr, next
1710     result <- increment
1711     loop
1712   }
1713   return result
1714 }
1715 
1716 # Render the line of words in line, along with the state of the stack under each word.
1717 # Also render any expanded function calls using recursive calls.
1718 #
1719 # Along the way, compute the column the cursor should be positioned at (cursor-col-addr).
1720 fn render-line screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), _line: (addr line), expanded-words: (addr handle call-path), top-row: int, left-col: int, curr-path: (addr handle call-path-element), cursor-word: (addr word), cursor-call-path: (addr handle call-path-element), cursor-row-addr: (addr int), cursor-col-addr: (addr int) -> _/ecx: int {
1721 #?   print-string 0, "render-line\n"
1722 #?   dump-table bindings
1723   # curr-word
1724   var line/esi: (addr line) <- copy _line
1725   var first-word-ah/eax: (addr handle word) <- get line, data
1726   var curr-word/eax: (addr word) <- lookup *first-word-ah
1727   #
1728   # loop-carried dependency
1729   var curr-col/ecx: int <- copy left-col
1730   #
1731   {
1732     compare curr-word, 0
1733     break-if-=
1734 #?     print-string 0, "-- word "
1735 #?     print-word 0, curr-word
1736 #?     print-string 0, "\n"
1737     # if necessary, first render columns for subsidiary stack
1738     $render-line:subsidiary: {
1739       {
1740 #?         print-string 0, "check sub\n"
1741         var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path
1742         compare display-subsidiary-stack?, 0/false
1743         break-if-= $render-line:subsidiary
1744       }
1745 #?       print-string 0, "render subsidiary stack\n"
1746       # does function exist?
1747       var callee/edi: (addr function) <- copy 0
1748       {
1749         var callee-h: (handle function)
1750         var callee-ah/ecx: (addr handle function) <- address callee-h
1751         callee functions, curr-word, callee-ah
1752         var _callee/eax: (addr function) <- lookup *callee-ah
1753         callee <- copy _callee
1754         compare callee, 0
1755         break-if-= $render-line:subsidiary
1756       }
1757       move-cursor screen, top-row, curr-col
1758       start-color screen, 8, 7
1759       print-word screen, curr-word
1760       {
1761         var word-len/eax: int <- word-length curr-word
1762         curr-col <- add word-len
1763         curr-col <- add 2
1764         increment top-row
1765       }
1766       # obtain stack at call site
1767       var stack-storage: value-stack
1768       var stack/edx: (addr value-stack) <- address stack-storage
1769       initialize-value-stack stack, 0x10
1770       {
1771         var prev-word-ah/eax: (addr handle word) <- get curr-word, prev
1772         var prev-word/eax: (addr word) <- lookup *prev-word-ah
1773         compare prev-word, 0
1774         break-if-=
1775         var bindings2-storage: table
1776         var bindings2/ebx: (addr table) <- address bindings2-storage
1777         deep-copy-table bindings, bindings2
1778         evaluate functions, bindings2, first-line, prev-word, stack
1779       }
1780       # construct new bindings
1781       var callee-bindings-storage: table
1782       var callee-bindings/esi: (addr table) <- address callee-bindings-storage
1783       initialize-table callee-bindings, 0x10
1784       bind-args callee, stack, callee-bindings
1785       # obtain body
1786       var callee-body-ah/eax: (addr handle line) <- get callee, body
1787       var callee-body/eax: (addr line) <- lookup *callee-body-ah
1788       var callee-body-first-word/edx: (addr handle word) <- get callee-body, data
1789       # - render subsidiary stack
1790       push-to-call-path-element curr-path, callee-body-first-word  # leak
1791 #?       print-string 0, "subsidiary {\n"
1792 #?       dump-table callee-bindings
1793 #?       syscall_exit
1794       curr-col <- render-line screen, functions, callee-bindings, callee-body, callee-body, expanded-words, top-row, curr-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr
1795 #?       print-string 0, "}\n"
1796       drop-from-call-path-element curr-path
1797       #
1798       move-cursor screen, top-row, curr-col
1799       print-code-point screen, 0x21d7/⇗
1800       #
1801       curr-col <- add 2
1802       decrement top-row
1803     }
1804     # render main column
1805     var old-col/edx: int <- copy curr-col
1806     var bindings2-storage: table
1807     var bindings2/ebx: (addr table) <- address bindings2-storage
1808 #?     print-string 0, "deep-copy {\n"
1809     deep-copy-table bindings, bindings2
1810 #?     print-string 0, "}\n"
1811 #?     print-string 0, "render column {\n"
1812     curr-col <- render-column screen, functions, bindings2, first-line, line, curr-word, top-row, curr-col
1813 #?     print-string 0, "}\n"
1814     # cache cursor column if necessary
1815     $render-line:cache-cursor-column: {
1816       {
1817         var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path
1818         compare found?, 0/false
1819         break-if-= $render-line:cache-cursor-column
1820       }
1821       var dest/edi: (addr int) <- copy cursor-row-addr
1822       {
1823         var src/eax: int <- copy top-row
1824         copy-to *dest, src
1825       }
1826       dest <- copy cursor-col-addr
1827       copy-to *dest, old-col
1828       var cursor-index-in-word/eax: int <- cursor-index curr-word
1829       add-to *dest, cursor-index-in-word
1830     }
1831     # loop update
1832 #?     print-string 0, "next word\n"
1833     var next-word-ah/edx: (addr handle word) <- get curr-word, next
1834     curr-word <- lookup *next-word-ah
1835 #?     {
1836 #?       var foo/eax: int <- copy curr-word
1837 #?       print-int32-hex 0, foo
1838 #?       print-string 0, "\n"
1839 #?     }
1840     increment-final-element curr-path
1841     loop
1842   }
1843   return curr-col
1844 }
1845 
1846 fn callee functions: (addr handle function), word: (addr word), out: (addr handle function) {
1847   var stream-storage: (stream byte 0x10)
1848   var stream/esi: (addr stream byte) <- address stream-storage
1849   emit-word word, stream
1850   find-function functions, stream, out
1851 }
1852 
1853 # Render:
1854 #   - starting at top-row, left-col: final-word
1855 #   - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive)
1856 #
1857 # Return the farthest column written.
1858 fn render-column screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), line: (addr line), final-word: (addr word), top-row: int, left-col: int -> _/ecx: int {
1859 #?   print-string 0, "render-column\n"
1860 #?   dump-table bindings
1861   var max-width/esi: int <- copy 0
1862   {
1863     # compute stack
1864     var stack: value-stack
1865     var stack-addr/edi: (addr value-stack) <- address stack
1866     initialize-value-stack stack-addr, 0x10/max-words
1867     # copy bindings
1868     var bindings2-storage: table
1869     var bindings2/ebx: (addr table) <- address bindings2-storage
1870 #?     print-string 0, "deep copy table {\n"
1871     deep-copy-table bindings, bindings2
1872 #?     print-string 0, "}\n"
1873     evaluate functions, bindings2, first-line, final-word, stack-addr
1874     # indent stack
1875     var indented-col/ebx: int <- copy left-col
1876     indented-col <- add 1/margin-right
1877     # render stack
1878     var curr-row/edx: int <- copy top-row
1879     curr-row <- add 2/stack-margin-top
1880     {
1881       var top-addr/ecx: (addr int) <- get stack-addr, top
1882       compare *top-addr, 0
1883       break-if-<=
1884       decrement *top-addr
1885       var data-ah/eax: (addr handle array value) <- get stack-addr, data
1886       var data/eax: (addr array value) <- lookup *data-ah
1887       var top/ecx: int <- copy *top-addr
1888       var dest-offset/ecx: (offset value) <- compute-offset data, top
1889       var val/eax: (addr value) <- index data, dest-offset
1890       render-value-at screen, curr-row, indented-col, val, 1/top-level=true
1891       {
1892         var width/eax: int <- value-width val, 1
1893         compare width, max-width
1894         break-if-<=
1895         max-width <- copy width
1896       }
1897       var height/eax: int <- value-height val
1898       curr-row <- add height
1899       loop
1900     }
1901   }
1902 
1903   max-width <- add 2  # spaces on either side of items on the stack
1904 
1905   # render word, initialize result
1906   reset-formatting screen
1907   move-cursor screen, top-row, left-col
1908   print-word screen, final-word
1909   {
1910     var width/eax: int <- word-length final-word
1911     compare width, max-width
1912     break-if-<=
1913     max-width <- copy width
1914   }
1915 
1916   # post-process right-col
1917   var right-col/ecx: int <- copy left-col
1918   right-col <- add max-width
1919   right-col <- add 1/margin-right
1920 #?   print-int32-decimal 0, left-col
1921 #?   print-string 0, " => "
1922 #?   print-int32-decimal 0, right-col
1923 #?   print-string 0, "\n"
1924   return right-col
1925 }
1926 
1927 fn render-function-menu _env: (addr environment) {
1928   var env/esi: (addr environment) <- copy _env
1929   var screen-ah/edi: (addr handle screen) <- get env, screen
1930   var _screen/eax: (addr screen) <- lookup *screen-ah
1931   var screen/edi: (addr screen) <- copy _screen
1932   var nrows/eax: (addr int) <- get env, nrows
1933   move-cursor screen, *nrows, 0
1934   start-reverse-video screen
1935   print-string screen, " ctrl-q "
1936   reset-formatting screen
1937   print-string screen, " quit     "
1938   start-reverse-video screen
1939   print-string screen, " ctrl-a "
1940   reset-formatting screen
1941   print-string screen, " ⏮   "
1942   start-reverse-video screen
1943   print-string screen, " ctrl-b "
1944   reset-formatting screen
1945   print-string screen, " ◀ word  "
1946   start-reverse-video screen
1947   print-string screen, " ctrl-f "
1948   reset-formatting screen
1949   print-string screen, " word ▶  "
1950   start-reverse-video screen
1951   print-string screen, " ctrl-e "
1952   reset-formatting screen
1953   print-string screen, " ⏭       "
1954   start-reverse-video screen
1955   print-string screen, " ctrl-g "
1956   reset-formatting screen
1957   print-string screen, " go to function  "
1958   start-reverse-video screen
1959   print-string screen, " tab "
1960   reset-formatting screen
1961   print-string screen, " go to sandbox"
1962 }
1963 
1964 fn render-sandbox-menu _env: (addr environment) {
1965   var env/esi: (addr environment) <- copy _env
1966   var screen-ah/edi: (addr handle screen) <- get env, screen
1967   var _screen/eax: (addr screen) <- lookup *screen-ah
1968   var screen/edi: (addr screen) <- copy _screen
1969   var nrows/eax: (addr int) <- get env, nrows
1970   move-cursor screen, *nrows, 0
1971   start-reverse-video screen
1972   print-string screen, " ctrl-q "
1973   reset-formatting screen
1974   print-string screen, " quit     "
1975   start-reverse-video screen
1976   print-string screen, " ctrl-a "
1977   reset-formatting screen
1978   print-string screen, " ⏮   "
1979   start-reverse-video screen
1980   print-string screen, " ctrl-b "
1981   reset-formatting screen
1982   print-string screen, " ◀ word  "
1983   start-reverse-video screen
1984   print-string screen, " ctrl-f "
1985   reset-formatting screen
1986   print-string screen, " word ▶  "
1987   start-reverse-video screen
1988   print-string screen, " ctrl-e "
1989   reset-formatting screen
1990   print-string screen, " ⏭       "
1991   start-reverse-video screen
1992   print-string screen, " ctrl-g "
1993   reset-formatting screen
1994   print-string screen, " go to function     "
1995   start-reverse-video screen
1996   print-string screen, " ctrl-l "
1997   reset-formatting screen
1998   print-string screen, " new line "
1999   start-reverse-video screen
2000   print-string screen, " ctrl-u "
2001   reset-formatting screen
2002   print-string screen, " clear  "
2003   start-reverse-video screen
2004   print-string screen, " ctrl-n "
2005   reset-formatting screen
2006   print-string screen, " name word  "
2007   start-reverse-video screen
2008   print-string screen, " ctrl-d "
2009   reset-formatting screen
2010   print-string screen, " define function"
2011 }
2012 
2013 fn clear-canvas _env: (addr environment) {
2014   var env/esi: (addr environment) <- copy _env
2015   var screen-ah/edi: (addr handle screen) <- get env, screen
2016   var _screen/eax: (addr screen) <- lookup *screen-ah
2017   var screen/edi: (addr screen) <- copy _screen
2018   clear-screen screen
2019   var nrows/eax: (addr int) <- get env, nrows
2020   var sep-col/ecx: (addr int) <- get env, code-separator-col
2021   # divider
2022   draw-vertical-line screen, 1, *nrows, *sep-col
2023   # primitives
2024   var dummy/eax: int <- render-primitives screen, *nrows, *sep-col
2025 }
2026 
2027 # return value: top-most row written to
2028 fn render-primitives screen: (addr screen), bottom-margin-row: int, right-col: int -> _/eax: int {
2029   # render primitives from the bottom of the screen upward
2030   var row/ecx: int <- copy bottom-margin-row
2031   row <- subtract 1
2032   var col/edx: int <- copy 1
2033   move-cursor screen, row, col
2034   row, col <- render-primitive-group screen, row, col, right-col, "numbers: ", "+ - * / sqrt  "
2035   row, col <- render-primitive-group screen, row, col, right-col, "arrays: ", "len  "
2036   row, col <- render-primitive-group screen, row, col, right-col, "files: ", "open read slurp lines  "
2037   row, col <- render-primitive-group screen, row, col, right-col, "misc: ", "dup swap  "  # hack: keep these at the right of the bottom row
2038   row, col <- render-primitive-group screen, row, col, right-col, "screens: ", "fake-screen print move up down left right  "
2039   # finally print heading up top
2040   row <- decrement
2041   move-cursor screen, row, 1
2042   start-bold screen
2043   print-string screen, "primitives:"
2044   reset-formatting screen
2045   return row
2046 }
2047 
2048 # start at row, col and print the given strings
2049 # move up one row if there isn't enough room before right-col
2050 # return row, col printed until
2051 fn render-primitive-group screen: (addr screen), _row: int, _col: int, right-col: int, _heading: (addr array byte), _contents: (addr array byte) -> _/ecx: int, _/edx: int {
2052   var row/ecx: int <- copy _row
2053   var col/edx: int <- copy _col
2054   # decrement row if necessary
2055   var new-col/ebx: int <- copy col
2056   var heading/esi: (addr array byte) <- copy _heading
2057   var len1/eax: int <- length heading
2058   new-col <- add len1
2059   var contents/edi: (addr array byte) <- copy _contents
2060   var len2/eax: int <- length contents
2061   new-col <- add len2
2062   var bound/eax: int <- copy right-col
2063   bound <- decrement
2064   {
2065     compare new-col, bound
2066     break-if-<=
2067     row <- decrement
2068     col <- copy 1
2069   }
2070   move-cursor screen, row, col
2071   start-color screen, 0xf6, 7
2072   print-string screen, heading
2073   reset-formatting screen
2074   print-string screen, contents
2075   return row, new-col
2076 }
2077 
2078 fn render-functions screen: (addr screen), right-col: int, _env: (addr environment) {
2079   var row/ecx: int <- copy 1
2080   var dummy-col/edx: int <- copy right-col
2081   var env/esi: (addr environment) <- copy _env
2082   var functions/esi: (addr handle function) <- get env, functions
2083   {
2084     var curr/eax: (addr function) <- lookup *functions
2085     compare curr, 0
2086     break-if-=
2087     row, dummy-col <- render-function-right-aligned screen, row, right-col, curr
2088     functions <- get curr, next
2089     row <- add 1/inter-function-margin
2090     loop
2091   }
2092 }
2093 
2094 # print function starting at row, right-aligned before right-col
2095 # return row, col printed until
2096 fn render-function-right-aligned screen: (addr screen), row: int, right-col: int, f: (addr function) -> _/ecx: int, _/edx: int {
2097   var col/edx: int <- copy right-col
2098   col <- subtract 1/function-right-margin
2099   var col2/ebx: int <- copy col
2100   var width/eax: int <- function-width f
2101   col <- subtract width
2102   var new-row/ecx: int <- copy row
2103   var height/eax: int <- function-height f
2104   new-row <- add height
2105   new-row <- decrement
2106   col <- subtract 1/function-left-padding
2107   start-color screen, 0, 0xf7
2108   clear-rect screen, row, col, new-row, col2
2109   col <- add 1
2110 #?   var dummy/eax: code-point-utf8 <- read-key-from-real-keyboard
2111   render-function screen, row, col, f
2112   new-row <- add 1/function-bottom-margin
2113   col <- subtract 1/function-left-padding
2114   col <- subtract 1/function-left-margin
2115   reset-formatting screen
2116   return new-row, col
2117 }
2118 
2119 # render function starting at row, col
2120 # only single-line functions supported for now
2121 fn render-function screen: (addr screen), row: int, col: int, _f: (addr function) {
2122   var f/esi: (addr function) <- copy _f
2123   var args/ecx: (addr handle word) <- get f, args
2124   move-cursor screen, row, col
2125   print-words-in-reverse screen, args
2126   var name-ah/eax: (addr handle array byte) <- get f, name
2127   var name/eax: (addr array byte) <- lookup *name-ah
2128   start-bold screen
2129   print-string screen, name
2130   reset-formatting screen
2131   start-color screen, 0, 0xf7
2132   increment row
2133   add-to col, 2
2134   move-cursor screen, row, col
2135   print-string screen, "≡ "
2136   add-to col, 2
2137   var cursor-row/ecx: (addr int) <- get f, cursor-row
2138   var cursor-col/edx: (addr int) <- get f, cursor-col
2139   var cursor-word-ah/eax: (addr handle word) <- get f, cursor-word
2140   var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
2141   var cursor-word/ebx: (addr word) <- copy _cursor-word
2142   var body-ah/eax: (addr handle line) <- get f, body
2143   var body/eax: (addr line) <- lookup *body-ah
2144   render-line-without-stack screen, body, row, col, cursor-word, cursor-row, cursor-col
2145 }
2146 
2147 fn real-code-point-utf8? g: code-point-utf8 -> _/eax: boolean {
2148   # if g == newline return true
2149   compare g, 0xa
2150   {
2151     break-if-!=
2152     return 1/true
2153   }
2154   # if g == tab return true
2155   compare g, 9
2156   {
2157     break-if-!=
2158     return 1/true
2159   }
2160   # if g < 32 return false
2161   compare g, 0x20
2162   {
2163     break-if->=
2164     return 0/false
2165   }
2166   # if g <= 255 return true
2167   compare g, 0xff
2168   {
2169     break-if->
2170     return 1/true
2171   }
2172   # if (g&0xff == Esc) it's an escape sequence
2173   and-with g, 0xff
2174   compare g, 0x1b/esc
2175   {
2176     break-if-!=
2177     return 0/false
2178   }
2179   # otherwise return true
2180   return 1/true
2181 }