1 type environment {
   2   screen: (handle screen)
   3   functions: (handle function)
   4   sandboxes: (handle sandbox)
   5   nrows: int
   6   ncols: int
   7   code-separator-col: int
   8 }
   9 
  10 fn initialize-environment _env: (addr environment) {
  11   var env/esi: (addr environment) <- copy _env
  12   # initialize some predefined function definitions
  13   var functions/eax: (addr handle function) <- get env, functions
  14   create-primitive-functions functions
  15   # initialize first sandbox
  16   var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
  17   allocate sandbox-ah
  18   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
  19   initialize-sandbox sandbox
  20   # initialize screen
  21   var screen-ah/eax: (addr handle screen) <- get env, screen
  22   var _screen/eax: (addr screen) <- lookup *screen-ah
  23   var screen/edi: (addr screen) <- copy _screen
  24   var nrows/eax: int <- copy 0
  25   var ncols/ecx: int <- copy 0
  26   nrows, ncols <- screen-size screen
  27   var dest/edx: (addr int) <- get env, nrows
  28   copy-to *dest, nrows
  29   dest <- get env, ncols
  30   copy-to *dest, ncols
  31   var repl-col/ecx: int <- copy ncols
  32   repl-col <- shift-right 1
  33   dest <- get env, code-separator-col
  34   copy-to *dest, repl-col
  35 }
  36 
  37 fn draw-screen _env: (addr environment) {
  38   var env/esi: (addr environment) <- copy _env
  39   var screen-ah/eax: (addr handle screen) <- get env, screen
  40   var _screen/eax: (addr screen) <- lookup *screen-ah
  41   var screen/edi: (addr screen) <- copy _screen
  42   var dest/edx: (addr int) <- get env, code-separator-col
  43   var tmp/eax: int <- copy *dest
  44   clear-canvas env
  45   tmp <- add 2  # repl-margin-left
  46   move-cursor screen, 3, tmp  # input-row
  47 }
  48 
  49 fn initialize-environment-with-fake-screen _self: (addr environment), nrows: int, ncols: int {
  50   var self/esi: (addr environment) <- copy _self
  51   var screen-ah/eax: (addr handle screen) <- get self, screen
  52   allocate screen-ah
  53   var screen-addr/eax: (addr screen) <- lookup *screen-ah
  54   initialize-screen screen-addr, nrows, ncols
  55   initialize-environment self
  56 }
  57 
  58 #############
  59 # Iterate
  60 #############
  61 
  62 fn process _self: (addr environment), key: grapheme {
  63 $process:body: {
  64   var self/esi: (addr environment) <- copy _self
  65   var sandbox-ah/eax: (addr handle sandbox) <- get self, sandboxes
  66   var _sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
  67   var sandbox/edi: (addr sandbox) <- copy _sandbox
  68   var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
  69   var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah?
  70   compare rename-word-mode?, 0
  71   {
  72     break-if-=
  73 #?     print-string 0, "processing sandbox rename\n"
  74     process-sandbox-rename sandbox, key
  75     break $process:body
  76   }
  77   var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function
  78   var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah?
  79   compare define-function-mode?, 0
  80   {
  81     break-if-=
  82 #?     print-string 0, "processing function definition\n"
  83     var functions/ecx: (addr handle function) <- get self, functions
  84     process-sandbox-define sandbox, functions, key
  85     break $process:body
  86   }
  87 #?   print-string 0, "processing sandbox\n"
  88   process-sandbox self, sandbox, key
  89 }
  90 }
  91 
  92 fn process-sandbox _self: (addr environment), _sandbox: (addr sandbox), key: grapheme {
  93 $process-sandbox:body: {
  94   var self/esi: (addr environment) <- copy _self
  95   var sandbox/edi: (addr sandbox) <- copy _sandbox
  96   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
  97   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
  98   var cursor-word-ah/ebx: (addr handle word) <- get cursor-call-path, word
  99   var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 100   var cursor-word/ecx: (addr word) <- copy _cursor-word
 101   compare key, 0x445b1b  # left-arrow
 102   $process-sandbox:key-left-arrow: {
 103     break-if-!=
 104 #?     print-string 0, "left-arrow\n"
 105     # if not at start, move left within current word
 106     var at-start?/eax: boolean <- cursor-at-start? cursor-word
 107     compare at-start?, 0  # false
 108     {
 109       break-if-!=
 110 #?       print-string 0, "cursor left within word\n"
 111       cursor-left cursor-word
 112       break $process-sandbox:body
 113     }
 114     # if current word is expanded, move to the rightmost word in its body
 115     {
 116       var cursor-call-path/esi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 117       var expanded-words/edx: (addr handle call-path) <- get sandbox, expanded-words
 118       var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
 119       compare curr-word-is-expanded?, 0  # false
 120       break-if-=
 121       # update cursor-call-path
 122 #?       print-string 0, "curr word is expanded\n"
 123       var self/ecx: (addr environment) <- copy _self
 124       var functions/ecx: (addr handle function) <- get self, functions
 125       var body: (handle line)
 126       var body-ah/eax: (addr handle line) <- address body
 127       function-body functions, cursor-word-ah, body-ah
 128       var body-addr/eax: (addr line) <- lookup *body-ah
 129       var first-word-ah/edx: (addr handle word) <- get body-addr, data
 130       var final-word-h: (handle word)
 131       var final-word-ah/eax: (addr handle word) <- address final-word-h
 132       final-word first-word-ah, final-word-ah
 133       push-to-call-path-element cursor-call-path, final-word-ah
 134       # move cursor to end of word
 135       var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 136       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 137       var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 138       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 139       cursor-to-end cursor-word
 140       break $process-sandbox:body
 141     }
 142     # if at first word, look for a caller to jump to
 143     $process-sandbox:key-left-arrow-first-word: {
 144       var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 145       var prev-word/eax: (addr word) <- lookup *prev-word-ah
 146       compare prev-word, 0
 147       break-if-!=
 148       $process-sandbox:key-left-arrow-first-word-and-caller: {
 149 #?         print-string 0, "return\n"
 150         {
 151           var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 152           var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 153           var next-cursor-element-ah/edx: (addr handle call-path-element) <- get cursor-call-path, next
 154           var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
 155           compare next-cursor-element, 0
 156           break-if-= $process-sandbox:key-left-arrow-first-word-and-caller
 157           copy-object next-cursor-element-ah, cursor-call-path-ah
 158         }
 159         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 160         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 161         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 162         var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 163         cursor-word <- copy _cursor-word
 164       }
 165     }
 166     # then move to end of previous word
 167     var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 168     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 169     {
 170       compare prev-word, 0
 171       break-if-=
 172 #?       print-string 0, "previous word\n"
 173       cursor-to-end prev-word
 174       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 175       decrement-final-element cursor-call-path
 176     }
 177     break $process-sandbox:body
 178   }
 179   compare key, 0x435b1b  # right-arrow
 180   $process-sandbox:key-right-arrow: {
 181     break-if-!=
 182     # if not at end, move right within current word
 183     var at-end?/eax: boolean <- cursor-at-end? cursor-word
 184     compare at-end?, 0  # false
 185     {
 186       break-if-!=
 187 #?       print-string 0, "a\n"
 188       cursor-right cursor-word
 189       break $process-sandbox:body
 190     }
 191     # if at final word, look for a caller to jump to
 192     {
 193       var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 194       var next-word/eax: (addr word) <- lookup *next-word-ah
 195       compare next-word, 0
 196       break-if-!=
 197       var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 198       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 199       var next-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 200       var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
 201       compare next-cursor-element, 0
 202       break-if-=
 203       copy-object next-cursor-element-ah, cursor-call-path-ah
 204       break $process-sandbox:body
 205     }
 206     # otherwise, move to the next word
 207     var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 208     var next-word/eax: (addr word) <- lookup *next-word-ah
 209     {
 210       compare next-word, 0
 211       break-if-=
 212 #?       print-string 0, "b\n"
 213       cursor-to-start next-word
 214       # . . cursor-word now out of date
 215       var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 216       increment-final-element cursor-call-path
 217       # Is the new cursor word expanded? If so, it's a function call. Add a
 218       # new level to the cursor-call-path for the call's body.
 219       $process-sandbox:key-right-arrow-next-word-is-call-expanded: {
 220 #?         print-string 0, "c\n"
 221         {
 222           var expanded-words/eax: (addr handle call-path) <- get sandbox, expanded-words
 223           var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
 224           compare curr-word-is-expanded?, 0  # false
 225           break-if-= $process-sandbox:key-right-arrow-next-word-is-call-expanded
 226         }
 227         var callee-h: (handle function)
 228         var callee-ah/edx: (addr handle function) <- address callee-h
 229         var functions/ebx: (addr handle function) <- get self, functions
 230         callee functions, next-word, callee-ah
 231         var callee/eax: (addr function) <- lookup *callee-ah
 232         var callee-body-ah/eax: (addr handle line) <- get callee, body
 233         var callee-body/eax: (addr line) <- lookup *callee-body-ah
 234         var callee-body-first-word/edx: (addr handle word) <- get callee-body, data
 235         push-to-call-path-element cursor-call-path, callee-body-first-word
 236         # position cursor at left
 237         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 238         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 239         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 240         var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 241         cursor-to-start cursor-word
 242 #?         print-string 0, "d\n"
 243         break $process-sandbox:body
 244       }
 245     }
 246     break $process-sandbox:body
 247   }
 248   compare key, 0xa  # enter
 249   {
 250     break-if-!=
 251     # toggle display of subsidiary stack
 252     toggle-cursor-word sandbox
 253     break $process-sandbox:body
 254   }
 255   # word-based motions
 256   compare key, 2  # ctrl-b
 257   $process-sandbox:prev-word: {
 258     break-if-!=
 259     # jump to previous word at same level
 260     var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 261     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 262     {
 263       compare prev-word, 0
 264       break-if-=
 265       cursor-to-end prev-word
 266       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 267       decrement-final-element cursor-call-path
 268       break $process-sandbox:body
 269     }
 270     # if previous word doesn't exist, try to bump up one level
 271     {
 272       var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 273       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 274       var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 275       var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah
 276       compare caller-cursor-element, 0
 277       break-if-=
 278       # check if previous word exists in caller
 279       var caller-word-ah/eax: (addr handle word) <- get caller-cursor-element, word
 280       var caller-word/eax: (addr word) <- lookup *caller-word-ah
 281       var word-before-caller-ah/eax: (addr handle word) <- get caller-word, prev
 282       var word-before-caller/eax: (addr word) <- lookup *word-before-caller-ah
 283       compare word-before-caller, 0
 284       break-if-=
 285       # if so jump to it
 286       drop-from-call-path-element cursor-call-path-ah
 287       decrement-final-element cursor-call-path-ah
 288       break $process-sandbox:body
 289     }
 290   }
 291   compare key, 6  # ctrl-f
 292   $process-sandbox:next-word: {
 293     break-if-!=
 294 #?     print-string 0, "AA\n"
 295     # jump to previous word at same level
 296     var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 297     var next-word/eax: (addr word) <- lookup *next-word-ah
 298     {
 299       compare next-word, 0
 300       break-if-=
 301 #?       print-string 0, "BB\n"
 302       cursor-to-end next-word
 303       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 304       increment-final-element cursor-call-path
 305       break $process-sandbox:body
 306     }
 307     # if next word doesn't exist, try to bump up one level
 308 #?     print-string 0, "CC\n"
 309     var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 310     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 311     var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 312     var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah
 313     compare caller-cursor-element, 0
 314     break-if-=
 315 #?     print-string 0, "DD\n"
 316     copy-object caller-cursor-element-ah, cursor-call-path-ah
 317     break $process-sandbox:body
 318   }
 319   # line-based motions
 320   compare key, 1  # ctrl-a
 321   $process-sandbox:start-of-line: {
 322     break-if-!=
 323     # move cursor up past all calls and to start of line
 324     var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 325     drop-nested-calls cursor-call-path-ah
 326     move-final-element-to-start-of-line cursor-call-path-ah
 327     # move cursor to start of initial word
 328     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 329     var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 330     var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 331     cursor-to-start cursor-word
 332     # this works as long as the first word isn't expanded
 333     # but we don't expect to see zero-arg functions first-up
 334     break $process-sandbox:body
 335   }
 336   compare key, 5  # ctrl-e
 337   $process-sandbox:end-of-line: {
 338     break-if-!=
 339     # move cursor to final word of sandbox
 340     var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 341     initialize-path-from-sandbox sandbox, cursor-call-path-ah
 342     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 343     var dest/eax: (addr handle word) <- get cursor-call-path, word
 344     final-word dest, dest
 345     # move cursor to end of final word
 346     var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 347     cursor-to-end cursor-word
 348     # this works because expanded words lie to the right of their bodies
 349     # so the final word is always guaranteed to be at the top-level
 350     break $process-sandbox:body
 351   }
 352   compare key, 0x15  # ctrl-u
 353   $process-sandbox:clear-line: {
 354     break-if-!=
 355     # clear line in sandbox
 356     initialize-sandbox sandbox
 357     break $process-sandbox:body
 358   }
 359   # if cursor is within a call, disable editing hotkeys below
 360   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 361   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 362   var next-cursor-element-ah/eax: (addr handle call-path-element) <- get cursor-call-path, next
 363   var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
 364   compare next-cursor-element, 0
 365   break-if-!= $process-sandbox:body
 366   # - remaining keys only work at the top row outside any function calls
 367   compare key, 0x7f  # del (backspace on Macs)
 368   $process-sandbox:backspace: {
 369     break-if-!=
 370     # if not at start of some word, delete grapheme before cursor within current word
 371     var at-start?/eax: boolean <- cursor-at-start? cursor-word
 372     compare at-start?, 0  # false
 373     {
 374       break-if-!=
 375       delete-before-cursor cursor-word
 376       break $process-sandbox:body
 377     }
 378     # otherwise delete current word and move to end of prev word
 379     var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
 380     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 381     {
 382       compare prev-word, 0
 383       break-if-=
 384       cursor-to-end prev-word
 385       delete-next prev-word
 386       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 387       decrement-final-element cursor-call-path
 388     }
 389     break $process-sandbox:body
 390   }
 391   compare key, 0x20  # space
 392   $process-sandbox:space: {
 393     break-if-!=
 394     # insert new word
 395     append-word cursor-word-ah
 396     var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 397     increment-final-element cursor-call-path
 398     break $process-sandbox:body
 399   }
 400   compare key, 0xe  # ctrl-n
 401   $process:rename-word: {
 402     break-if-!=
 403     # TODO: ensure current word is not a function
 404     # rename word at cursor
 405     var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 406     allocate new-name-ah
 407     var new-name/eax: (addr word) <- lookup *new-name-ah
 408     initialize-word new-name
 409     break $process-sandbox:body
 410   }
 411   compare key, 4  # ctrl-d
 412   $process:define-function: {
 413     break-if-!=
 414     # define function out of line at cursor
 415     var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-function
 416     allocate new-name-ah
 417     var new-name/eax: (addr word) <- lookup *new-name-ah
 418     initialize-word new-name
 419     break $process-sandbox:body
 420   }
 421   # otherwise insert key within current word
 422   var g/edx: grapheme <- copy key
 423   var print?/eax: boolean <- real-grapheme? key
 424   $process-sandbox:real-grapheme: {
 425     compare print?, 0  # false
 426     break-if-=
 427     add-grapheme-to-word cursor-word, g
 428     break $process-sandbox:body
 429   }
 430   # silently ignore other hotkeys
 431 }
 432 }
 433 
 434 # collect new name in partial-name-for-cursor-word, and then rename the word
 435 # at cursor to it
 436 # Precondition: cursor-call-path is a singleton (not within a call)
 437 fn process-sandbox-rename _sandbox: (addr sandbox), key: grapheme {
 438 $process-sandbox-rename:body: {
 439   var sandbox/esi: (addr sandbox) <- copy _sandbox
 440   var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 441   # if 'esc' pressed, cancel rename
 442   compare key, 0x1b  # esc
 443   $process-sandbox-rename:cancel: {
 444     break-if-!=
 445     var empty: (handle word)
 446     copy-handle empty, new-name-ah
 447     break $process-sandbox-rename:body
 448   }
 449   # if 'enter' pressed, perform rename
 450   compare key, 0xa  # enter
 451   $process-sandbox-rename:commit: {
 452     break-if-!=
 453 #?     print-string 0, "rename\n"
 454     # new line
 455     var new-line-h: (handle line)
 456     var new-line-ah/eax: (addr handle line) <- address new-line-h
 457     allocate new-line-ah
 458     var new-line/eax: (addr line) <- lookup *new-line-ah
 459     initialize-line new-line
 460     var new-line-word-ah/ecx: (addr handle word) <- get new-line, data
 461     {
 462       # move word at cursor to new line
 463       var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 464       var cursor/eax: (addr call-path-element) <- lookup *cursor-ah
 465       var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
 466 #?       print-string 0, "cursor before at word "
 467 #?       {
 468 #?         var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 469 #?         print-word 0, cursor-word
 470 #?         print-string 0, "\n"
 471 #?       }
 472       move-word-contents word-at-cursor-ah, new-line-word-ah
 473       # copy name to word at cursor
 474       copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah
 475 #?       print-string 0, "cursor after at word "
 476 #?       {
 477 #?         var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 478 #?         print-word 0, cursor-word
 479 #?         print-string 0, "\n"
 480 #?         var foo/eax: int <- copy cursor-word
 481 #?         print-int32-hex 0, foo
 482 #?         print-string 0, "\n"
 483 #?       }
 484 #?       print-string 0, "new name word "
 485 #?       {
 486 #?         var new-name/eax: (addr word) <- lookup *new-name-ah
 487 #?         print-word 0, new-name
 488 #?         print-string 0, "\n"
 489 #?         var foo/eax: int <- copy new-name
 490 #?         print-int32-hex 0, foo
 491 #?         print-string 0, "\n"
 492 #?       }
 493     }
 494     # prepend '=' to name
 495     {
 496       var new-name/eax: (addr word) <- lookup *new-name-ah
 497       cursor-to-start new-name
 498       add-grapheme-to-word new-name, 0x3d  # '='
 499     }
 500     # append name to new line
 501     chain-words new-line-word-ah, new-name-ah
 502     # new-line->next = sandbox->data
 503     var new-line-next/ecx: (addr handle line) <- get new-line, next
 504     var sandbox-slot/edx: (addr handle line) <- get sandbox, data
 505     copy-object sandbox-slot, new-line-next
 506     # sandbox->data = new-line
 507     copy-handle new-line-h, sandbox-slot
 508     # clear partial-name-for-cursor-word
 509     var empty: (handle word)
 510     copy-handle empty, new-name-ah
 511 #?     # XXX
 512 #?     var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 513 #?     var cursor/eax: (addr call-path-element) <- lookup *cursor-ah
 514 #?     var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
 515 #?     print-string 0, "cursor after rename: "
 516 #?     {
 517 #?       var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 518 #?       print-word 0, cursor-word
 519 #?       print-string 0, " -- "
 520 #?       var foo/eax: int <- copy cursor-word
 521 #?       print-int32-hex 0, foo
 522 #?       print-string 0, "\n"
 523 #?     }
 524     break $process-sandbox-rename:body
 525   }
 526   #
 527   compare key, 0x7f  # del (backspace on Macs)
 528   $process-sandbox-rename:backspace: {
 529     break-if-!=
 530     # if not at start, delete grapheme before cursor
 531     var new-name/eax: (addr word) <- lookup *new-name-ah
 532     var at-start?/eax: boolean <- cursor-at-start? new-name
 533     compare at-start?, 0  # false
 534     {
 535       break-if-!=
 536       var new-name/eax: (addr word) <- lookup *new-name-ah
 537       delete-before-cursor new-name
 538     }
 539     break $process-sandbox-rename:body
 540   }
 541   # otherwise insert key within current word
 542   var print?/eax: boolean <- real-grapheme? key
 543   $process-sandbox-rename:real-grapheme: {
 544     compare print?, 0  # false
 545     break-if-=
 546     var new-name/eax: (addr word) <- lookup *new-name-ah
 547     add-grapheme-to-word new-name, key
 548     break $process-sandbox-rename:body
 549   }
 550   # silently ignore other hotkeys
 551 }
 552 }
 553 
 554 # collect new name in partial-name-for-function, and then define the last line
 555 # of the sandbox to be a new function with that name. Replace the last line
 556 # with a call to the appropriate function.
 557 # Precondition: cursor-call-path is a singleton (not within a call)
 558 fn process-sandbox-define _sandbox: (addr sandbox), functions: (addr handle function), key: grapheme {
 559 $process-sandbox-define:body: {
 560   var sandbox/esi: (addr sandbox) <- copy _sandbox
 561   var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-function
 562   # if 'esc' pressed, cancel define
 563   compare key, 0x1b  # esc
 564   $process-sandbox-define:cancel: {
 565     break-if-!=
 566     var empty: (handle word)
 567     copy-handle empty, new-name-ah
 568     break $process-sandbox-define:body
 569   }
 570   # if 'enter' pressed, perform define
 571   compare key, 0xa  # enter
 572   $process-sandbox-define:commit: {
 573     break-if-!=
 574 #?     print-string 0, "define\n"
 575     # create new function
 576     var new-function: (handle function)
 577     var new-function-ah/ecx: (addr handle function) <- address new-function
 578     allocate new-function-ah
 579     var _new-function/eax: (addr function) <- lookup *new-function-ah
 580     var new-function/ebx: (addr function) <- copy _new-function
 581     var dest/edx: (addr handle function) <- get new-function, next
 582     copy-object functions, dest
 583     copy-object new-function-ah, functions
 584     # set function name to new-name
 585     var new-name/eax: (addr word) <- lookup *new-name-ah
 586     var dest/edx: (addr handle array byte) <- get new-function, name
 587     word-to-string new-name, dest
 588     # move final line to body
 589     var body-ah/eax: (addr handle line) <- get new-function, body
 590     allocate body-ah
 591     var body/eax: (addr line) <- lookup *body-ah
 592     var body-contents/ecx: (addr handle word) <- get body, data
 593     var final-line-storage: (handle line)
 594     var final-line-ah/eax: (addr handle line) <- address final-line-storage
 595     final-line sandbox, final-line-ah
 596     var final-line/eax: (addr line) <- lookup *final-line-ah
 597     var final-line-contents/eax: (addr handle word) <- get final-line, data
 598     copy-object final-line-contents, body-contents
 599     #
 600     copy-unbound-words-to-args functions
 601     #
 602     var empty-word: (handle word)
 603     copy-handle empty-word, final-line-contents
 604     construct-call functions, final-line-contents
 605     # clear partial-name-for-function
 606     var empty-word: (handle word)
 607     copy-handle empty-word, new-name-ah
 608     # update cursor
 609     var final-line/eax: (addr line) <- lookup final-line-storage
 610     var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 611     allocate cursor-call-path-ah  # leak
 612     initialize-path-from-line final-line, cursor-call-path-ah
 613     break $process-sandbox-define:body
 614   }
 615   #
 616   compare key, 0x7f  # del (backspace on Macs)
 617   $process-sandbox-define:backspace: {
 618     break-if-!=
 619     # if not at start, delete grapheme before cursor
 620     var new-name/eax: (addr word) <- lookup *new-name-ah
 621     var at-start?/eax: boolean <- cursor-at-start? new-name
 622     compare at-start?, 0  # false
 623     {
 624       break-if-!=
 625       var new-name/eax: (addr word) <- lookup *new-name-ah
 626       delete-before-cursor new-name
 627     }
 628     break $process-sandbox-define:body
 629   }
 630   # otherwise insert key within current word
 631   var print?/eax: boolean <- real-grapheme? key
 632   $process-sandbox-define:real-grapheme: {
 633     compare print?, 0  # false
 634     break-if-=
 635     var new-name/eax: (addr word) <- lookup *new-name-ah
 636     add-grapheme-to-word new-name, key
 637     break $process-sandbox-define:body
 638   }
 639   # silently ignore other hotkeys
 640 }
 641 }
 642 
 643 # extract from the body of the first function in 'functions' all words that
 644 # aren't defined in the rest of 'functions'. Prepend them in reverse order.
 645 # Assumes function body is a single line for now.
 646 fn copy-unbound-words-to-args _functions: (addr handle function) {
 647   # target
 648   var target-ah/eax: (addr handle function) <- copy _functions
 649   var _target/eax: (addr function) <- lookup *target-ah
 650   var target/esi: (addr function) <- copy _target
 651   var dest-ah/edi: (addr handle word) <- get target, args
 652   # next
 653   var functions-ah/edx: (addr handle function) <- get target, next
 654   # src
 655   var line-ah/eax: (addr handle line) <- get target, body
 656   var line/eax: (addr line) <- lookup *line-ah
 657   var curr-ah/eax: (addr handle word) <- get line, data
 658   var curr/eax: (addr word) <- lookup *curr-ah
 659   {
 660     compare curr, 0
 661     break-if-=
 662     $copy-unbound-words-to-args:loop-iter: {
 663       # is it a number?
 664       {
 665         var is-int?/eax: boolean <- word-is-decimal-integer? curr
 666         compare is-int?, 0  # false
 667         break-if-!= $copy-unbound-words-to-args:loop-iter
 668       }
 669       # is it a pre-existing function?
 670       var bound?/ebx: boolean <- bound-function? curr, functions-ah
 671       compare bound?, 0  # false
 672       break-if-!=
 673       # is it already bound as an arg?
 674       var dup?/ebx: boolean <- arg-exists? _functions, curr  # _functions = target-ah
 675       compare dup?, 0  # false
 676       break-if-!= $copy-unbound-words-to-args:loop-iter
 677       # push copy of curr before dest-ah
 678       var rest-h: (handle word)
 679       var rest-ah/ecx: (addr handle word) <- address rest-h
 680       copy-object dest-ah, rest-ah
 681       copy-word curr, dest-ah
 682       chain-words dest-ah, rest-ah
 683     }
 684     var next-ah/ecx: (addr handle word) <- get curr, next
 685     curr <- lookup *next-ah
 686     loop
 687   }
 688 }
 689 
 690 fn bound-function? w: (addr word), functions-ah: (addr handle function) -> result/ebx: boolean {
 691   result <- copy 1  # true
 692   # if w == "+" return true
 693   var subresult/eax: boolean <- word-equal? w, "+"
 694   compare subresult, 0  # false
 695   break-if-!=
 696   # if w == "-" return true
 697   subresult <- word-equal? w, "-"
 698   compare subresult, 0  # false
 699   break-if-!=
 700   # if w == "*" return true
 701   subresult <- word-equal? w, "*"
 702   compare subresult, 0  # false
 703   break-if-!=
 704   # return w in functions
 705   var out-h: (handle function)
 706   var out/eax: (addr handle function) <- address out-h
 707   callee functions-ah, w, out
 708   var found?/eax: (addr function) <- lookup *out
 709   result <- copy found?
 710 }
 711 
 712 fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> result/ebx: boolean {
 713   var f-ah/eax: (addr handle function) <- copy *_f-ah
 714   var f/eax: (addr function) <- lookup *f-ah
 715   var args-ah/eax: (addr handle word) <- get f, args
 716   result <- word-exists? args-ah, arg
 717 }
 718 
 719 # construct a call to `f` with copies of exactly its args
 720 fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) {
 721   var f-ah/eax: (addr handle function) <- copy _f-ah
 722   var _f/eax: (addr function) <- lookup *f-ah
 723   var f/esi: (addr function) <- copy _f
 724   # append args in reverse
 725   var args-ah/eax: (addr handle word) <- get f, args
 726   var dest-ah/edi: (addr handle word) <- copy _dest-ah
 727   copy-words-in-reverse args-ah, dest-ah
 728   # append name
 729   var name-ah/eax: (addr handle array byte) <- get f, name
 730   var name/eax: (addr array byte) <- lookup *name-ah
 731   append-word-at-end-with dest-ah, name
 732 }
 733 
 734 fn word-index _words: (addr handle word), _n: int, out: (addr handle word) {
 735 $word-index:body: {
 736   var n/ecx: int <- copy _n
 737   {
 738     compare n, 0
 739     break-if-!=
 740     copy-object _words, out
 741     break $word-index:body
 742   }
 743   var words-ah/eax: (addr handle word) <- copy _words
 744   var words/eax: (addr word) <- lookup *words-ah
 745   var next/eax: (addr handle word) <- get words, next
 746   n <- decrement
 747   word-index next, n, out
 748 }
 749 }
 750 
 751 fn toggle-cursor-word _sandbox: (addr sandbox) {
 752 $toggle-cursor-word:body: {
 753   var sandbox/esi: (addr sandbox) <- copy _sandbox
 754   var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
 755   var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 756 #?   print-string 0, "cursor call path: "
 757 #?   dump-call-path-element 0, cursor-call-path
 758 #?   print-string 0, "expanded words:\n"
 759 #?   dump-call-paths 0, expanded-words
 760   var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
 761   compare already-expanded?, 0  # false
 762   {
 763     break-if-!=
 764 #?     print-string 0, "expand\n"
 765     # if not already-expanded, insert
 766     insert-in-call-path expanded-words cursor-call-path
 767 #?     print-string 0, "expanded words now:\n"
 768 #?     dump-call-paths 0, expanded-words
 769     break $toggle-cursor-word:body
 770   }
 771   {
 772     break-if-=
 773     # otherwise delete
 774     delete-in-call-path expanded-words cursor-call-path
 775   }
 776 }
 777 }
 778 
 779 #############
 780 # Visualize
 781 #############
 782 
 783 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) {
 784   var env/esi: (addr environment) <- copy _env
 785   # functions
 786   var functions/edx: (addr handle function) <- get env, functions
 787   # line
 788   var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes
 789   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
 790   var line-ah/eax: (addr handle line) <- get sandbox, data
 791   var _line/eax: (addr line) <- lookup *line-ah
 792   var line/esi: (addr line) <- copy _line
 793   evaluate functions, 0, line, 0, stack
 794 }
 795 
 796 fn render _env: (addr environment) {
 797 #?   print-string 0, "==\n"
 798   var env/esi: (addr environment) <- copy _env
 799   clear-canvas env
 800   # screen
 801   var screen-ah/eax: (addr handle screen) <- get env, screen
 802   var _screen/eax: (addr screen) <- lookup *screen-ah
 803   var screen/edi: (addr screen) <- copy _screen
 804   # repl-col
 805   var _repl-col/eax: (addr int) <- get env, code-separator-col
 806   var repl-col/ecx: int <- copy *_repl-col
 807   repl-col <- add 2  # repl-margin-left
 808   # functions
 809   var functions/edx: (addr handle function) <- get env, functions
 810   # sandbox
 811   var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
 812   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
 813 #?   {
 814 #?     var line-ah/eax: (addr handle line) <- get sandbox, data
 815 #?     var line/eax: (addr line) <- lookup *line-ah
 816 #?     var first-word-ah/eax: (addr handle word) <- get line, data
 817 #?     var curr-word/eax: (addr word) <- lookup *first-word-ah
 818 #?     print-word 0, curr-word
 819 #?     print-string 0, "\n"
 820 #?   }
 821   # bindings
 822   var bindings-storage: table
 823   var bindings/ebx: (addr table) <- address bindings-storage
 824   initialize-table bindings, 0x10
 825   render-sandbox screen, functions, bindings, sandbox, 3, repl-col
 826 }
 827 
 828 fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int {
 829   var sandbox/esi: (addr sandbox) <- copy _sandbox
 830   # line
 831   var curr-line-ah/eax: (addr handle line) <- get sandbox, data
 832   var _curr-line/eax: (addr line) <- lookup *curr-line-ah
 833   var curr-line/ecx: (addr line) <- copy _curr-line
 834   #
 835   var curr-row/edx: int <- copy top-row
 836   # cursor row, col
 837   var cursor-row: int
 838   var cursor-row-addr: (addr int)
 839   var tmp/eax: (addr int) <- address cursor-row
 840   copy-to cursor-row-addr, tmp
 841   var cursor-col: int
 842   var cursor-col-addr: (addr int)
 843   tmp <- address cursor-col
 844   copy-to cursor-col-addr, tmp
 845   # render all but final line without stack
 846 #?   print-string 0, "render all but final line\n"
 847   {
 848     var next-line-ah/eax: (addr handle line) <- get curr-line, next
 849     var next-line/eax: (addr line) <- lookup *next-line-ah
 850     compare next-line, 0
 851     break-if-=
 852     {
 853       var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 854       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 855       var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 856       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 857 #?       print-string 0, "cursor 2: "
 858 #?       {
 859 #?         print-word 0, cursor-word
 860 #?         print-string 0, " -- "
 861 #?         var foo/eax: int <- copy cursor-word
 862 #?         print-int32-hex 0, foo
 863 #?         print-string 0, "\n"
 864 #?       }
 865       # 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
 866       render-line-without-stack screen, curr-line, curr-row, left-col, cursor-word, cursor-row-addr, cursor-col-addr
 867     }
 868     curr-line <- copy next-line
 869     curr-row <- add 2
 870     loop
 871   }
 872   #
 873 #?   print-string 0, "render final line\n"
 874   render-final-line-with-stack screen, functions, bindings, sandbox, curr-row, left-col, cursor-row-addr, cursor-col-addr
 875   # at most one of the following dialogs will be rendered
 876   render-rename-dialog screen, sandbox, cursor-row, cursor-col
 877   render-define-dialog screen, sandbox, cursor-row, cursor-col
 878   move-cursor screen, cursor-row, cursor-col
 879 }
 880 
 881 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) {
 882   var sandbox/esi: (addr sandbox) <- copy _sandbox
 883   # expanded-words
 884   var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
 885   # cursor-word
 886   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 887   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 888   var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 889   var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 890   var cursor-word/ebx: (addr word) <- copy _cursor-word
 891   # cursor-call-path
 892   var cursor-call-path: (addr handle call-path-element)
 893   {
 894     var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 895     copy-to cursor-call-path, src
 896   }
 897   # first line
 898   var first-line-ah/eax: (addr handle line) <- get sandbox, data
 899   var _first-line/eax: (addr line) <- lookup *first-line-ah
 900   var first-line/edx: (addr line) <- copy _first-line
 901   # final line
 902   var final-line-storage: (handle line)
 903   var final-line-ah/eax: (addr handle line) <- address final-line-storage
 904   final-line sandbox, final-line-ah
 905   var final-line/eax: (addr line) <- lookup *final-line-ah
 906   # curr-path
 907   var curr-path-storage: (handle call-path-element)
 908   var curr-path/ecx: (addr handle call-path-element) <- address curr-path-storage
 909   allocate curr-path  # leak
 910   initialize-path-from-line final-line, curr-path
 911   #
 912   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
 913 }
 914 
 915 fn final-line _sandbox: (addr sandbox), out: (addr handle line) {
 916   var sandbox/esi: (addr sandbox) <- copy _sandbox
 917   var curr-line-ah/ecx: (addr handle line) <- get sandbox, data
 918   {
 919     var curr-line/eax: (addr line) <- lookup *curr-line-ah
 920     var next-line-ah/edx: (addr handle line) <- get curr-line, next
 921     var next-line/eax: (addr line) <- lookup *next-line-ah
 922     compare next-line, 0
 923     break-if-=
 924     curr-line-ah <- copy next-line-ah
 925     loop
 926   }
 927   copy-object curr-line-ah, out
 928 }
 929 
 930 fn render-rename-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int {
 931   var sandbox/edi: (addr sandbox) <- copy _sandbox
 932   var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 933   var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah?
 934   compare rename-word-mode?, 0
 935   break-if-=
 936   # clear a space for the dialog
 937   var top-row/eax: int <- copy cursor-row
 938   top-row <- subtract 3
 939   var bottom-row/ecx: int <- copy cursor-row
 940   bottom-row <- add 3
 941   var left-col/edx: int <- copy cursor-col
 942   left-col <- subtract 0x10
 943   var right-col/ebx: int <- copy cursor-col
 944   right-col <- add 0x10
 945   clear-rect screen, top-row, left-col, bottom-row, right-col
 946   draw-box screen, top-row, left-col, bottom-row, right-col
 947   # render a little menu for the dialog
 948   var menu-row/ecx: int <- copy bottom-row
 949   menu-row <- decrement
 950   var menu-col/edx: int <- copy left-col
 951   menu-col <- add 2
 952   move-cursor screen, menu-row, menu-col
 953   start-reverse-video screen
 954   print-string screen, " esc "
 955   reset-formatting screen
 956   print-string screen, " cancel  "
 957   start-reverse-video screen
 958   print-string screen, " enter "
 959   reset-formatting screen
 960   print-string screen, " rename  "
 961   # draw the word, positioned appropriately around the cursor
 962   var start-col/ecx: int <- copy cursor-col
 963   var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 964   var word/eax: (addr word) <- lookup *word-ah?
 965   var cursor-index/eax: int <- cursor-index word
 966   start-col <- subtract cursor-index
 967   move-cursor screen, cursor-row, start-col
 968   var word/eax: (addr word) <- lookup *word-ah?
 969   print-word screen, word
 970 }
 971 
 972 fn render-define-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int {
 973   var sandbox/edi: (addr sandbox) <- copy _sandbox
 974   var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function
 975   var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah?
 976   compare define-function-mode?, 0
 977   break-if-=
 978   # clear a space for the dialog
 979   var top-row/eax: int <- copy cursor-row
 980   top-row <- subtract 3
 981   var bottom-row/ecx: int <- copy cursor-row
 982   bottom-row <- add 3
 983   var left-col/edx: int <- copy cursor-col
 984   left-col <- subtract 0x10
 985   var right-col/ebx: int <- copy cursor-col
 986   right-col <- add 0x10
 987   clear-rect screen, top-row, left-col, bottom-row, right-col
 988   draw-box screen, top-row, left-col, bottom-row, right-col
 989   # render a little menu for the dialog
 990   var menu-row/ecx: int <- copy bottom-row
 991   menu-row <- decrement
 992   var menu-col/edx: int <- copy left-col
 993   menu-col <- add 2
 994   move-cursor screen, menu-row, menu-col
 995   start-reverse-video screen
 996   print-string screen, " esc "
 997   reset-formatting screen
 998   print-string screen, " cancel  "
 999   start-reverse-video screen
1000   print-string screen, " enter "
1001   reset-formatting screen
1002   print-string screen, " define  "
1003   # draw the word, positioned appropriately around the cursor
1004   var start-col/ecx: int <- copy cursor-col
1005   var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function
1006   var word/eax: (addr word) <- lookup *word-ah?
1007   var cursor-index/eax: int <- cursor-index word
1008   start-col <- subtract cursor-index
1009   move-cursor screen, cursor-row, start-col
1010   var word/eax: (addr word) <- lookup *word-ah?
1011   print-word screen, word
1012 }
1013 
1014 # Render just the words in 'line'.
1015 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) {
1016   # curr-word
1017   var line/eax: (addr line) <- copy _line
1018   var first-word-ah/eax: (addr handle word) <- get line, data
1019   var _curr-word/eax: (addr word) <- lookup *first-word-ah
1020   var curr-word/esi: (addr word) <- copy _curr-word
1021   #
1022   # loop-carried dependency
1023   var curr-col/ecx: int <- copy left-col
1024   #
1025   {
1026     compare curr-word, 0
1027     break-if-=
1028 #?     print-string 0, "-- word in penultimate lines: "
1029 #?     {
1030 #?       var foo/eax: int <- copy curr-word
1031 #?       print-int32-hex 0, foo
1032 #?     }
1033 #?     print-string 0, "\n"
1034     var old-col/edx: int <- copy curr-col
1035     reset-formatting screen
1036     move-cursor screen, curr-row, curr-col
1037     print-word screen, curr-word
1038     {
1039       var max-width/eax: int <- word-length curr-word
1040       curr-col <- add max-width
1041       curr-col <- add 1  # margin-right
1042     }
1043     # cache cursor column if necessary
1044     {
1045       compare curr-word, cursor-word
1046       break-if-!=
1047 #?       print-string 0, "Cursor at "
1048 #?       print-int32-decimal 0, curr-row
1049 #?       print-string 0, ", "
1050 #?       print-int32-decimal 0, old-col
1051 #?       print-string 0, "\n"
1052 #?       print-string 0, "contents: "
1053 #?       print-word 0, cursor-word
1054 #?       print-string 0, "\n"
1055 #?       {
1056 #?         var foo/eax: int <- copy cursor-word
1057 #?         print-int32-hex 0, foo
1058 #?         print-string 0, "\n"
1059 #?       }
1060       var dest/ecx: (addr int) <- copy cursor-row-addr
1061       var src/eax: int <- copy curr-row
1062       copy-to *dest, src
1063       dest <- copy cursor-col-addr
1064       copy-to *dest, old-col
1065       var cursor-index-in-word/eax: int <- cursor-index curr-word
1066       add-to *dest, cursor-index-in-word
1067     }
1068     # loop update
1069     var next-word-ah/edx: (addr handle word) <- get curr-word, next
1070     var _curr-word/eax: (addr word) <- lookup *next-word-ah
1071     curr-word <- copy _curr-word
1072     loop
1073   }
1074 }
1075 
1076 fn call-depth-at-cursor _sandbox: (addr sandbox) -> result/eax: int {
1077   var sandbox/esi: (addr sandbox) <- copy _sandbox
1078   var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
1079   result <- call-path-element-length cursor-call-path
1080   result <- add 2  # input-row-1
1081 }
1082 
1083 fn call-path-element-length _x: (addr handle call-path-element) -> result/eax: int {
1084   var curr-ah/ecx: (addr handle call-path-element) <- copy _x
1085   var out/edi: int <- copy 0
1086   {
1087     var curr/eax: (addr call-path-element) <- lookup *curr-ah
1088     compare curr, 0
1089     break-if-=
1090     curr-ah <- get curr, next
1091     out <- increment
1092     loop
1093   }
1094   result <- copy out
1095 }
1096 
1097 # Render the line of words in line, along with the state of the stack under each word.
1098 # Also render any expanded function calls using recursive calls.
1099 #
1100 # Along the way, compute the column the cursor should be positioned at (cursor-col-addr).
1101 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) -> right-col/ecx: int {
1102 #?   print-string 0, "--\n"
1103   # curr-word
1104   var line/esi: (addr line) <- copy _line
1105   var first-word-ah/eax: (addr handle word) <- get line, data
1106   var curr-word/eax: (addr word) <- lookup *first-word-ah
1107   var debug-row: int
1108   copy-to debug-row, 0x20
1109   #
1110   # loop-carried dependency
1111   var curr-col/ecx: int <- copy left-col
1112   #
1113   {
1114     compare curr-word, 0
1115     break-if-=
1116 #?     print-string 0, "-- word in final line: "
1117 #?     {
1118 #?       var foo/eax: int <- copy curr-word
1119 #?       print-int32-hex 0, foo
1120 #?     }
1121 #?     print-string 0, "\n"
1122     # if necessary, first render columns for subsidiary stack
1123     $render-line:subsidiary: {
1124       {
1125 #?         print-string 0, "check sub\n"
1126         var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path
1127         compare display-subsidiary-stack?, 0  # false
1128         break-if-= $render-line:subsidiary
1129       }
1130 #?       print-string 0, "render subsidiary stack\n"
1131       # does function exist?
1132       var callee/edi: (addr function) <- copy 0
1133       {
1134         var callee-h: (handle function)
1135         var callee-ah/ecx: (addr handle function) <- address callee-h
1136         callee functions, curr-word, callee-ah
1137         var _callee/eax: (addr function) <- lookup *callee-ah
1138         callee <- copy _callee
1139         compare callee, 0
1140         break-if-= $render-line:subsidiary
1141       }
1142       move-cursor screen, top-row, curr-col
1143       start-color screen, 8, 7
1144       print-word screen, curr-word
1145       {
1146         var word-len/eax: int <- word-length curr-word
1147         curr-col <- add word-len
1148         curr-col <- add 2
1149         increment top-row
1150       }
1151       # obtain stack at call site
1152       var stack-storage: value-stack
1153       var stack/edx: (addr value-stack) <- address stack-storage
1154       initialize-value-stack stack, 0x10
1155       {
1156         var prev-word-ah/eax: (addr handle word) <- get curr-word, prev
1157         var prev-word/eax: (addr word) <- lookup *prev-word-ah
1158         compare prev-word, 0
1159         break-if-=
1160         evaluate functions, bindings, line, prev-word, stack
1161       }
1162       # construct new bindings
1163       var callee-bindings-storage: table
1164       var callee-bindings/esi: (addr table) <- address callee-bindings-storage
1165       initialize-table callee-bindings, 0x10
1166       bind-args callee, stack, callee-bindings
1167       # obtain body
1168       var callee-body-ah/eax: (addr handle line) <- get callee, body
1169       var callee-body/eax: (addr line) <- lookup *callee-body-ah
1170       var callee-body-first-word/edx: (addr handle word) <- get callee-body, data
1171       # - render subsidiary stack
1172       push-to-call-path-element curr-path, callee-body-first-word  # leak
1173       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
1174       drop-from-call-path-element curr-path
1175       #
1176       move-cursor screen, top-row, curr-col
1177       print-code-point screen, 0x21d7  # ⇗
1178       #
1179       curr-col <- add 2
1180       decrement top-row
1181     }
1182     # render main column
1183     var old-col/edx: int <- copy curr-col
1184 #?     move-cursor 0, debug-row, 1
1185 #?     increment debug-row
1186 #?     print-string 0, "rendering column from "
1187 #?     print-int32-decimal 0, curr-col
1188 #?     print-string 0, "\n"
1189     curr-col <- render-column screen, functions, bindings, first-line, line, curr-word, top-row, curr-col
1190     # cache cursor column if necessary
1191     $render-line:cache-cursor-column: {
1192 #?       print-string 0, "cache cursor? "
1193 #?       {
1194 #?         var foo/eax: int <- copy curr-word
1195 #?         print-int32-hex 0, foo
1196 #?       }
1197 #?       print-string 0, "\n"
1198       {
1199         var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path
1200         compare found?, 0  # false
1201         break-if-= $render-line:cache-cursor-column
1202       }
1203 #?       print-string 0, "cursor at "
1204 #?       print-int32-decimal 0, top-row
1205 #?       print-string 0, ", "
1206 #?       print-int32-decimal 0, old-col
1207 #?       print-string 0, "\n"
1208       var dest/edi: (addr int) <- copy cursor-row-addr
1209       {
1210         var src/eax: int <- copy top-row
1211         copy-to *dest, src
1212       }
1213       dest <- copy cursor-col-addr
1214       copy-to *dest, old-col
1215       var cursor-index-in-word/eax: int <- cursor-index curr-word
1216       add-to *dest, cursor-index-in-word
1217     }
1218     # loop update
1219 #?     print-string 0, "next word\n"
1220     var next-word-ah/edx: (addr handle word) <- get curr-word, next
1221     curr-word <- lookup *next-word-ah
1222 #?     {
1223 #?       var foo/eax: int <- copy curr-word
1224 #?       print-int32-hex 0, foo
1225 #?       print-string 0, "\n"
1226 #?     }
1227     increment-final-element curr-path
1228     loop
1229   }
1230   right-col <- copy curr-col
1231 }
1232 
1233 fn callee functions: (addr handle function), word: (addr word), out: (addr handle function) {
1234   var stream-storage: (stream byte 0x10)
1235   var stream/esi: (addr stream byte) <- address stream-storage
1236   emit-word word, stream
1237   find-function functions, stream, out
1238 }
1239 
1240 # Render:
1241 #   - starting at top-row, left-col: final-word
1242 #   - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive)
1243 #
1244 # Return the farthest column written.
1245 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 -> right-col/ecx: int {
1246 #?   print-string 0, "render-column\n"
1247   var max-width/esi: int <- copy 0
1248   {
1249     # indent stack
1250     var indented-col/ebx: int <- copy left-col
1251     indented-col <- add 1  # margin-right
1252     # compute stack
1253     var stack: value-stack
1254     var stack-addr/edi: (addr value-stack) <- address stack
1255     initialize-value-stack stack-addr, 0x10  # max-words
1256     evaluate functions, bindings, first-line, final-word, stack-addr
1257     # render stack
1258     var curr-row/edx: int <- copy top-row
1259     curr-row <- add 3  # stack-margin-top
1260     var _max-width/eax: int <- value-stack-max-width stack-addr
1261     max-width <- copy _max-width
1262     var i/eax: int <- value-stack-length stack-addr
1263     {
1264       compare i, 0
1265       break-if-<=
1266       move-cursor screen, curr-row, indented-col
1267       {
1268         var val/eax: int <- pop-int-from-value-stack stack-addr
1269 #?         print-int32-decimal 0, val
1270 #?         print-string 0, "\n"
1271         render-integer screen, val, max-width
1272       }
1273       curr-row <- increment
1274       i <- decrement
1275       loop
1276     }
1277   }
1278 
1279   max-width <- add 2  # spaces on either side of items on the stack
1280 
1281   # render word, initialize result
1282   reset-formatting screen
1283   move-cursor screen, top-row, left-col
1284   print-word screen, final-word
1285   {
1286     var size/eax: int <- word-length final-word
1287     compare size, max-width
1288     break-if-<=
1289     max-width <- copy size
1290   }
1291 
1292   # post-process right-col
1293   right-col <- copy left-col
1294   right-col <- add max-width
1295   right-col <- add 1  # margin-right
1296 #?   print-int32-decimal 0, left-col
1297 #?   print-string 0, " => "
1298 #?   print-int32-decimal 0, right-col
1299 #?   print-string 0, "\n"
1300 }
1301 
1302 # synaesthesia
1303 fn render-integer screen: (addr screen), val: int, max-width: int {
1304   var bg/eax: int <- hash-color val
1305   var fg/ecx: int <- copy 7
1306   {
1307     compare bg, 2
1308     break-if-!=
1309     fg <- copy 0
1310   }
1311   {
1312     compare bg, 3
1313     break-if-!=
1314     fg <- copy 0
1315   }
1316   {
1317     compare bg, 6
1318     break-if-!=
1319     fg <- copy 0
1320   }
1321   start-color screen, fg, bg
1322   print-grapheme screen, 0x20  # space
1323   print-int32-decimal-right-justified screen, val, max-width
1324   print-grapheme screen, 0x20  # space
1325 }
1326 
1327 fn hash-color val: int -> result/eax: int {
1328   result <- try-modulo val, 7  # assumes that 7 is always the background color
1329 }
1330 
1331 fn clear-canvas _env: (addr environment) {
1332   var env/esi: (addr environment) <- copy _env
1333   var screen-ah/edi: (addr handle screen) <- get env, screen
1334   var _screen/eax: (addr screen) <- lookup *screen-ah
1335   var screen/edi: (addr screen) <- copy _screen
1336   clear-screen screen
1337   var nrows/eax: (addr int) <- get env, nrows
1338   var _repl-col/ecx: (addr int) <- get env, code-separator-col
1339   var repl-col/ecx: int <- copy *_repl-col
1340   draw-vertical-line screen, 1, *nrows, repl-col
1341   # wordstar-style cheatsheet of shortcuts
1342   move-cursor screen, *nrows, 0
1343   start-reverse-video screen
1344   print-string screen, " ctrl-q "
1345   reset-formatting screen
1346   print-string screen, " quit "
1347   var menu-start/ecx: int <- copy repl-col
1348   menu-start <- subtract 0x40  # 64 = half the size of the menu
1349   move-cursor screen, *nrows, menu-start
1350   start-reverse-video screen
1351   print-string screen, " ctrl-a "
1352   reset-formatting screen
1353   print-string screen, " ⏮   "
1354   start-reverse-video screen
1355   print-string screen, " ctrl-b "
1356   reset-formatting screen
1357   print-string screen, " ◀ word  "
1358   start-reverse-video screen
1359   print-string screen, " ctrl-f "
1360   reset-formatting screen
1361   print-string screen, " word ▶  "
1362   start-reverse-video screen
1363   print-string screen, " ctrl-e "
1364   reset-formatting screen
1365   print-string screen, " ⏭   "
1366   start-reverse-video screen
1367   print-string screen, " ctrl-u "
1368   reset-formatting screen
1369   print-string screen, " clear line  "
1370   start-reverse-video screen
1371   print-string screen, " ctrl-n "
1372   reset-formatting screen
1373   print-string screen, " name value  "
1374   start-reverse-video screen
1375   print-string screen, " ctrl-d "
1376   reset-formatting screen
1377   print-string screen, " define function  "
1378   # currently defined functions
1379   var row/ecx: int <- copy 3
1380   var functions/esi: (addr handle function) <- get env, functions
1381   {
1382     var curr/eax: (addr function) <- lookup *functions
1383     compare curr, 0
1384     break-if-=
1385     move-cursor screen, row, 2
1386     render-function screen, curr
1387     functions <- get curr, next
1388     row <- increment
1389     loop
1390   }
1391 }
1392 
1393 # only single-line functions supported for now
1394 fn render-function screen: (addr screen), _f: (addr function) {
1395   var f/esi: (addr function) <- copy _f
1396   var args/ecx: (addr handle word) <- get f, args
1397   print-words-in-reverse screen, args
1398   var name-ah/eax: (addr handle array byte) <- get f, name
1399   var name/eax: (addr array byte) <- lookup *name-ah
1400   print-string screen, name
1401   print-string screen, " = "
1402   var body-ah/eax: (addr handle line) <- get f, body
1403   var body/eax: (addr line) <- lookup *body-ah
1404   var body-words-ah/eax: (addr handle word) <- get body, data
1405   print-words screen, body-words-ah
1406 }
1407 
1408 fn real-grapheme? g: grapheme -> result/eax: boolean {
1409 $real-grapheme?:body: {
1410   # if g == newline return true
1411   compare g, 0xa
1412   {
1413     break-if-!=
1414     result <- copy 1  # true
1415     break $real-grapheme?:body
1416   }
1417   # if g == tab return true
1418   compare g, 9
1419   {
1420     break-if-!=
1421     result <- copy 1  # true
1422     break $real-grapheme?:body
1423   }
1424   # if g < 32 return false
1425   compare g, 0x20
1426   {
1427     break-if->=
1428     result <- copy 0  # false
1429     break $real-grapheme?:body
1430   }
1431   # if g <= 255 return true
1432   compare g, 0xff
1433   {
1434     break-if->
1435     result <- copy 1  # true
1436     break $real-grapheme?:body
1437   }
1438   # if (g&0xff == Esc) it's an escape sequence
1439   and-with g, 0xff
1440   compare g, 0x1b  # Esc
1441   {
1442     break-if-!=
1443     result <- copy 0  # false
1444     break $real-grapheme?:body
1445   }
1446   # otherwise return true
1447   result <- copy 1  # true
1448 }
1449 }