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, "move to previous word\n"
 173       cursor-to-end prev-word
 174 #?       {
 175 #?         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 176 #?         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 177 #?         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 178 #?         var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 179 #?         var cursor-word/ebx: (addr word) <- copy _cursor-word
 180 #?         print-string 0, "word at cursor before: "
 181 #?         print-word 0, cursor-word
 182 #?         print-string 0, "\n"
 183 #?       }
 184       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 185       decrement-final-element cursor-call-path
 186 #?       {
 187 #?         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 188 #?         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 189 #?         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 190 #?         var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 191 #?         var cursor-word/ebx: (addr word) <- copy _cursor-word
 192 #?         print-string 0, "word at cursor after: "
 193 #?         print-word 0, cursor-word
 194 #?         print-string 0, "\n"
 195 #?       }
 196     }
 197     break $process-sandbox:body
 198   }
 199   compare key, 0x435b1b  # right-arrow
 200   $process-sandbox:key-right-arrow: {
 201     break-if-!=
 202     # if not at end, move right within current word
 203     var at-end?/eax: boolean <- cursor-at-end? cursor-word
 204     compare at-end?, 0  # false
 205     {
 206       break-if-!=
 207 #?       print-string 0, "a\n"
 208       cursor-right cursor-word
 209       break $process-sandbox:body
 210     }
 211     # if at final word, look for a caller to jump to
 212     {
 213       var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 214       var next-word/eax: (addr word) <- lookup *next-word-ah
 215       compare next-word, 0
 216       break-if-!=
 217       var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 218       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 219       var next-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 220       var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
 221       compare next-cursor-element, 0
 222       break-if-=
 223       copy-object next-cursor-element-ah, cursor-call-path-ah
 224       break $process-sandbox:body
 225     }
 226     # otherwise, move to the next word
 227     var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 228     var next-word/eax: (addr word) <- lookup *next-word-ah
 229     {
 230       compare next-word, 0
 231       break-if-=
 232 #?       print-string 0, "b\n"
 233       cursor-to-start next-word
 234       # . . cursor-word now out of date
 235       var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 236       increment-final-element cursor-call-path
 237       # Is the new cursor word expanded? If so, it's a function call. Add a
 238       # new level to the cursor-call-path for the call's body.
 239       $process-sandbox:key-right-arrow-next-word-is-call-expanded: {
 240 #?         print-string 0, "c\n"
 241         {
 242           var expanded-words/eax: (addr handle call-path) <- get sandbox, expanded-words
 243           var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
 244           compare curr-word-is-expanded?, 0  # false
 245           break-if-= $process-sandbox:key-right-arrow-next-word-is-call-expanded
 246         }
 247         var callee-h: (handle function)
 248         var callee-ah/edx: (addr handle function) <- address callee-h
 249         var functions/ebx: (addr handle function) <- get self, functions
 250         callee functions, next-word, callee-ah
 251         var callee/eax: (addr function) <- lookup *callee-ah
 252         var callee-body-ah/eax: (addr handle line) <- get callee, body
 253         var callee-body/eax: (addr line) <- lookup *callee-body-ah
 254         var callee-body-first-word/edx: (addr handle word) <- get callee-body, data
 255         push-to-call-path-element cursor-call-path, callee-body-first-word
 256         # position cursor at left
 257         var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 258         var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 259         var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 260         var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 261         cursor-to-start cursor-word
 262 #?         print-string 0, "d\n"
 263         break $process-sandbox:body
 264       }
 265     }
 266     break $process-sandbox:body
 267   }
 268   compare key, 0xa  # enter
 269   {
 270     break-if-!=
 271     # toggle display of subsidiary stack
 272     toggle-cursor-word sandbox
 273     break $process-sandbox:body
 274   }
 275   # word-based motions
 276   compare key, 2  # ctrl-b
 277   $process-sandbox:prev-word: {
 278     break-if-!=
 279     # jump to previous word at same level
 280     var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev
 281     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 282     {
 283       compare prev-word, 0
 284       break-if-=
 285       cursor-to-end prev-word
 286       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 287       decrement-final-element cursor-call-path
 288       break $process-sandbox:body
 289     }
 290     # if previous word doesn't exist, try to bump up one level
 291     {
 292       var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 293       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 294       var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 295       var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah
 296       compare caller-cursor-element, 0
 297       break-if-=
 298       # check if previous word exists in caller
 299       var caller-word-ah/eax: (addr handle word) <- get caller-cursor-element, word
 300       var caller-word/eax: (addr word) <- lookup *caller-word-ah
 301       var word-before-caller-ah/eax: (addr handle word) <- get caller-word, prev
 302       var word-before-caller/eax: (addr word) <- lookup *word-before-caller-ah
 303       compare word-before-caller, 0
 304       break-if-=
 305       # if so jump to it
 306       drop-from-call-path-element cursor-call-path-ah
 307       decrement-final-element cursor-call-path-ah
 308       break $process-sandbox:body
 309     }
 310   }
 311   compare key, 6  # ctrl-f
 312   $process-sandbox:next-word: {
 313     break-if-!=
 314 #?     print-string 0, "AA\n"
 315     # jump to previous word at same level
 316     var next-word-ah/edx: (addr handle word) <- get cursor-word, next
 317     var next-word/eax: (addr word) <- lookup *next-word-ah
 318     {
 319       compare next-word, 0
 320       break-if-=
 321 #?       print-string 0, "BB\n"
 322       cursor-to-end next-word
 323       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 324       increment-final-element cursor-call-path
 325       break $process-sandbox:body
 326     }
 327     # if next word doesn't exist, try to bump up one level
 328 #?     print-string 0, "CC\n"
 329     var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
 330     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 331     var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next
 332     var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah
 333     compare caller-cursor-element, 0
 334     break-if-=
 335 #?     print-string 0, "DD\n"
 336     copy-object caller-cursor-element-ah, cursor-call-path-ah
 337     break $process-sandbox:body
 338   }
 339   # line-based motions
 340   compare key, 1  # ctrl-a
 341   $process-sandbox:start-of-line: {
 342     break-if-!=
 343     # move cursor up past all calls and to start of line
 344     var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 345     drop-nested-calls cursor-call-path-ah
 346     move-final-element-to-start-of-line cursor-call-path-ah
 347     # move cursor to start of initial word
 348     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 349     var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 350     var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 351     cursor-to-start cursor-word
 352     # this works as long as the first word isn't expanded
 353     # but we don't expect to see zero-arg functions first-up
 354     break $process-sandbox:body
 355   }
 356   compare key, 5  # ctrl-e
 357   $process-sandbox:end-of-line: {
 358     break-if-!=
 359     # move cursor to final word of sandbox
 360     var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 361     initialize-path-from-sandbox sandbox, cursor-call-path-ah
 362     var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 363     var dest/eax: (addr handle word) <- get cursor-call-path, word
 364     final-word dest, dest
 365     # move cursor to end of final word
 366     var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 367     cursor-to-end cursor-word
 368     # this works because expanded words lie to the right of their bodies
 369     # so the final word is always guaranteed to be at the top-level
 370     break $process-sandbox:body
 371   }
 372   compare key, 0x15  # ctrl-u
 373   $process-sandbox:clear-line: {
 374     break-if-!=
 375     # clear line in sandbox
 376     initialize-sandbox sandbox
 377     break $process-sandbox:body
 378   }
 379   # if cursor is within a call, disable editing hotkeys below
 380   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 381   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 382   var next-cursor-element-ah/eax: (addr handle call-path-element) <- get cursor-call-path, next
 383   var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah
 384   compare next-cursor-element, 0
 385   break-if-!= $process-sandbox:body
 386   # - remaining keys only work at the top row outside any function calls
 387   compare key, 0x7f  # del (backspace on Macs)
 388   $process-sandbox:backspace: {
 389     break-if-!=
 390     # if not at start of some word, delete grapheme before cursor within current word
 391     var at-start?/eax: boolean <- cursor-at-start? cursor-word
 392     compare at-start?, 0  # false
 393     {
 394       break-if-!=
 395       delete-before-cursor cursor-word
 396       break $process-sandbox:body
 397     }
 398     # otherwise delete current word and move to end of prev word
 399     var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
 400     var prev-word/eax: (addr word) <- lookup *prev-word-ah
 401     {
 402       compare prev-word, 0
 403       break-if-=
 404       cursor-to-end prev-word
 405       delete-next prev-word
 406       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 407       decrement-final-element cursor-call-path
 408     }
 409     break $process-sandbox:body
 410   }
 411   compare key, 0x20  # space
 412   $process-sandbox:space: {
 413     break-if-!=
 414 #?     print-string 0, "space\n"
 415     # if cursor is at start of word, insert word before
 416     {
 417       var at-start?/eax: boolean <- cursor-at-start? cursor-word
 418       compare at-start?, 0  # false
 419       break-if-=
 420       var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev
 421       append-word prev-word-ah
 422       var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 423       decrement-final-element cursor-call-path
 424       break $process-sandbox:body
 425     }
 426     # if start of word is quote and grapheme before cursor is not, just insert it as usual
 427     # TODO: support string escaping
 428     {
 429       var first-grapheme/eax: grapheme <- first-grapheme cursor-word
 430       compare first-grapheme, 0x22  # double quote
 431       break-if-!=
 432       var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word
 433       compare final-grapheme, 0x22  # double quote
 434       break-if-=
 435       break $process-sandbox:space
 436     }
 437     # if start of word is '[' and grapheme before cursor is not ']', just insert it as usual
 438     # TODO: support nested arrays
 439     {
 440       var first-grapheme/eax: grapheme <- first-grapheme cursor-word
 441       compare first-grapheme, 0x5b  # '['
 442       break-if-!=
 443       var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word
 444       compare final-grapheme, 0x5d  # ']'
 445       break-if-=
 446       break $process-sandbox:space
 447     }
 448     # otherwise insert word after and move cursor to it for the next key
 449     # (but we'll continue to track the current cursor-word for the rest of this function)
 450     append-word cursor-word-ah
 451     var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 452     increment-final-element cursor-call-path
 453     # if cursor is at end of word, that's all
 454     var at-end?/eax: boolean <- cursor-at-end? cursor-word
 455     compare at-end?, 0  # false
 456     break-if-!= $process-sandbox:body
 457     # otherwise we're in the middle of a word
 458     # move everything after cursor to the (just created) next word
 459     var next-word-ah/eax: (addr handle word) <- get cursor-word, next
 460     var _next-word/eax: (addr word) <- lookup *next-word-ah
 461     var next-word/ebx: (addr word) <- copy _next-word
 462     {
 463       var at-end?/eax: boolean <- cursor-at-end? cursor-word
 464       compare at-end?, 0  # false
 465       break-if-!=
 466       var g/eax: grapheme <- pop-after-cursor cursor-word
 467       add-grapheme-to-word next-word, g
 468       loop
 469     }
 470     cursor-to-start next-word
 471     break $process-sandbox:body
 472   }
 473   compare key, 0xe  # ctrl-n
 474   $process:rename-word: {
 475     break-if-!=
 476     # TODO: ensure current word is not a function
 477     # rename word at cursor
 478     var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 479     allocate new-name-ah
 480     var new-name/eax: (addr word) <- lookup *new-name-ah
 481     initialize-word new-name
 482     break $process-sandbox:body
 483   }
 484   compare key, 4  # ctrl-d
 485   $process:define-function: {
 486     break-if-!=
 487     # define function out of line at cursor
 488     var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-function
 489     allocate new-name-ah
 490     var new-name/eax: (addr word) <- lookup *new-name-ah
 491     initialize-word new-name
 492     break $process-sandbox:body
 493   }
 494   # otherwise insert key within current word
 495   var g/edx: grapheme <- copy key
 496   var print?/eax: boolean <- real-grapheme? key
 497   $process-sandbox:real-grapheme: {
 498     compare print?, 0  # false
 499     break-if-=
 500     add-grapheme-to-word cursor-word, g
 501     break $process-sandbox:body
 502   }
 503   # silently ignore other hotkeys
 504 }
 505 }
 506 
 507 # collect new name in partial-name-for-cursor-word, and then rename the word
 508 # at cursor to it
 509 # Precondition: cursor-call-path is a singleton (not within a call)
 510 fn process-sandbox-rename _sandbox: (addr sandbox), key: grapheme {
 511 $process-sandbox-rename:body: {
 512   var sandbox/esi: (addr sandbox) <- copy _sandbox
 513   var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-cursor-word
 514   # if 'esc' pressed, cancel rename
 515   compare key, 0x1b  # esc
 516   $process-sandbox-rename:cancel: {
 517     break-if-!=
 518     var empty: (handle word)
 519     copy-handle empty, new-name-ah
 520     break $process-sandbox-rename:body
 521   }
 522   # if 'enter' pressed, perform rename
 523   compare key, 0xa  # enter
 524   $process-sandbox-rename:commit: {
 525     break-if-!=
 526 #?     print-string 0, "rename\n"
 527     # new line
 528     var new-line-h: (handle line)
 529     var new-line-ah/eax: (addr handle line) <- address new-line-h
 530     allocate new-line-ah
 531     var new-line/eax: (addr line) <- lookup *new-line-ah
 532     initialize-line new-line
 533     var new-line-word-ah/ecx: (addr handle word) <- get new-line, data
 534     {
 535       # move word at cursor to new line
 536       var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 537       var cursor/eax: (addr call-path-element) <- lookup *cursor-ah
 538       var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
 539 #?       print-string 0, "cursor before at word "
 540 #?       {
 541 #?         var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 542 #?         print-word 0, cursor-word
 543 #?         print-string 0, "\n"
 544 #?       }
 545       move-word-contents word-at-cursor-ah, new-line-word-ah
 546       # copy name to word at cursor
 547       copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah
 548 #?       print-string 0, "cursor after at word "
 549 #?       {
 550 #?         var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 551 #?         print-word 0, cursor-word
 552 #?         print-string 0, "\n"
 553 #?         var foo/eax: int <- copy cursor-word
 554 #?         print-int32-hex 0, foo
 555 #?         print-string 0, "\n"
 556 #?       }
 557 #?       print-string 0, "new name word "
 558 #?       {
 559 #?         var new-name/eax: (addr word) <- lookup *new-name-ah
 560 #?         print-word 0, new-name
 561 #?         print-string 0, "\n"
 562 #?         var foo/eax: int <- copy new-name
 563 #?         print-int32-hex 0, foo
 564 #?         print-string 0, "\n"
 565 #?       }
 566     }
 567     # prepend '=' to name
 568     {
 569       var new-name/eax: (addr word) <- lookup *new-name-ah
 570       cursor-to-start new-name
 571       add-grapheme-to-word new-name, 0x3d  # '='
 572     }
 573     # append name to new line
 574     chain-words new-line-word-ah, new-name-ah
 575     # new-line->next = sandbox->data
 576     var new-line-next/ecx: (addr handle line) <- get new-line, next
 577     var sandbox-slot/edx: (addr handle line) <- get sandbox, data
 578     copy-object sandbox-slot, new-line-next
 579     # sandbox->data = new-line
 580     copy-handle new-line-h, sandbox-slot
 581     # clear partial-name-for-cursor-word
 582     var empty: (handle word)
 583     copy-handle empty, new-name-ah
 584 #?     # XXX
 585 #?     var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 586 #?     var cursor/eax: (addr call-path-element) <- lookup *cursor-ah
 587 #?     var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
 588 #?     print-string 0, "cursor after rename: "
 589 #?     {
 590 #?       var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah
 591 #?       print-word 0, cursor-word
 592 #?       print-string 0, " -- "
 593 #?       var foo/eax: int <- copy cursor-word
 594 #?       print-int32-hex 0, foo
 595 #?       print-string 0, "\n"
 596 #?     }
 597     break $process-sandbox-rename:body
 598   }
 599   #
 600   compare key, 0x7f  # del (backspace on Macs)
 601   $process-sandbox-rename:backspace: {
 602     break-if-!=
 603     # if not at start, delete grapheme before cursor
 604     var new-name/eax: (addr word) <- lookup *new-name-ah
 605     var at-start?/eax: boolean <- cursor-at-start? new-name
 606     compare at-start?, 0  # false
 607     {
 608       break-if-!=
 609       var new-name/eax: (addr word) <- lookup *new-name-ah
 610       delete-before-cursor new-name
 611     }
 612     break $process-sandbox-rename:body
 613   }
 614   # otherwise insert key within current word
 615   var print?/eax: boolean <- real-grapheme? key
 616   $process-sandbox-rename:real-grapheme: {
 617     compare print?, 0  # false
 618     break-if-=
 619     var new-name/eax: (addr word) <- lookup *new-name-ah
 620     add-grapheme-to-word new-name, key
 621     break $process-sandbox-rename:body
 622   }
 623   # silently ignore other hotkeys
 624 }
 625 }
 626 
 627 # collect new name in partial-name-for-function, and then define the last line
 628 # of the sandbox to be a new function with that name. Replace the last line
 629 # with a call to the appropriate function.
 630 # Precondition: cursor-call-path is a singleton (not within a call)
 631 fn process-sandbox-define _sandbox: (addr sandbox), functions: (addr handle function), key: grapheme {
 632 $process-sandbox-define:body: {
 633   var sandbox/esi: (addr sandbox) <- copy _sandbox
 634   var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-function
 635   # if 'esc' pressed, cancel define
 636   compare key, 0x1b  # esc
 637   $process-sandbox-define:cancel: {
 638     break-if-!=
 639     var empty: (handle word)
 640     copy-handle empty, new-name-ah
 641     break $process-sandbox-define:body
 642   }
 643   # if 'enter' pressed, perform define
 644   compare key, 0xa  # enter
 645   $process-sandbox-define:commit: {
 646     break-if-!=
 647 #?     print-string 0, "define\n"
 648     # create new function
 649     var new-function: (handle function)
 650     var new-function-ah/ecx: (addr handle function) <- address new-function
 651     allocate new-function-ah
 652     var _new-function/eax: (addr function) <- lookup *new-function-ah
 653     var new-function/ebx: (addr function) <- copy _new-function
 654     var dest/edx: (addr handle function) <- get new-function, next
 655     copy-object functions, dest
 656     copy-object new-function-ah, functions
 657     # set function name to new-name
 658     var new-name/eax: (addr word) <- lookup *new-name-ah
 659     var dest/edx: (addr handle array byte) <- get new-function, name
 660     word-to-string new-name, dest
 661     # move final line to body
 662     var body-ah/eax: (addr handle line) <- get new-function, body
 663     allocate body-ah
 664     var body/eax: (addr line) <- lookup *body-ah
 665     var body-contents/ecx: (addr handle word) <- get body, data
 666     var final-line-storage: (handle line)
 667     var final-line-ah/eax: (addr handle line) <- address final-line-storage
 668     final-line sandbox, final-line-ah
 669     var final-line/eax: (addr line) <- lookup *final-line-ah
 670     var final-line-contents/eax: (addr handle word) <- get final-line, data
 671     copy-object final-line-contents, body-contents
 672     #
 673     copy-unbound-words-to-args functions
 674     #
 675     var empty-word: (handle word)
 676     copy-handle empty-word, final-line-contents
 677     construct-call functions, final-line-contents
 678     # clear partial-name-for-function
 679     var empty-word: (handle word)
 680     copy-handle empty-word, new-name-ah
 681     # update cursor
 682     var final-line/eax: (addr line) <- lookup final-line-storage
 683     var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 684     allocate cursor-call-path-ah  # leak
 685     initialize-path-from-line final-line, cursor-call-path-ah
 686     break $process-sandbox-define:body
 687   }
 688   #
 689   compare key, 0x7f  # del (backspace on Macs)
 690   $process-sandbox-define:backspace: {
 691     break-if-!=
 692     # if not at start, delete grapheme before cursor
 693     var new-name/eax: (addr word) <- lookup *new-name-ah
 694     var at-start?/eax: boolean <- cursor-at-start? new-name
 695     compare at-start?, 0  # false
 696     {
 697       break-if-!=
 698       var new-name/eax: (addr word) <- lookup *new-name-ah
 699       delete-before-cursor new-name
 700     }
 701     break $process-sandbox-define:body
 702   }
 703   # otherwise insert key within current word
 704   var print?/eax: boolean <- real-grapheme? key
 705   $process-sandbox-define:real-grapheme: {
 706     compare print?, 0  # false
 707     break-if-=
 708     var new-name/eax: (addr word) <- lookup *new-name-ah
 709     add-grapheme-to-word new-name, key
 710     break $process-sandbox-define:body
 711   }
 712   # silently ignore other hotkeys
 713 }
 714 }
 715 
 716 # extract from the body of the first function in 'functions' all words that
 717 # aren't defined in the rest of 'functions'. Prepend them in reverse order.
 718 # Assumes function body is a single line for now.
 719 fn copy-unbound-words-to-args _functions: (addr handle function) {
 720   # target
 721   var target-ah/eax: (addr handle function) <- copy _functions
 722   var _target/eax: (addr function) <- lookup *target-ah
 723   var target/esi: (addr function) <- copy _target
 724   var dest-ah/edi: (addr handle word) <- get target, args
 725   # next
 726   var functions-ah/edx: (addr handle function) <- get target, next
 727   # src
 728   var line-ah/eax: (addr handle line) <- get target, body
 729   var line/eax: (addr line) <- lookup *line-ah
 730   var curr-ah/eax: (addr handle word) <- get line, data
 731   var curr/eax: (addr word) <- lookup *curr-ah
 732   {
 733     compare curr, 0
 734     break-if-=
 735     $copy-unbound-words-to-args:loop-iter: {
 736       # is it a number?
 737       {
 738         var is-int?/eax: boolean <- word-is-decimal-integer? curr
 739         compare is-int?, 0  # false
 740         break-if-!= $copy-unbound-words-to-args:loop-iter
 741       }
 742       # is it a pre-existing function?
 743       var bound?/ebx: boolean <- bound-function? curr, functions-ah
 744       compare bound?, 0  # false
 745       break-if-!=
 746       # is it already bound as an arg?
 747       var dup?/ebx: boolean <- arg-exists? _functions, curr  # _functions = target-ah
 748       compare dup?, 0  # false
 749       break-if-!= $copy-unbound-words-to-args:loop-iter
 750       # push copy of curr before dest-ah
 751       var rest-h: (handle word)
 752       var rest-ah/ecx: (addr handle word) <- address rest-h
 753       copy-object dest-ah, rest-ah
 754       copy-word curr, dest-ah
 755       chain-words dest-ah, rest-ah
 756     }
 757     var next-ah/ecx: (addr handle word) <- get curr, next
 758     curr <- lookup *next-ah
 759     loop
 760   }
 761 }
 762 
 763 fn bound-function? w: (addr word), functions-ah: (addr handle function) -> _/ebx: boolean {
 764   var result/ebx: boolean <- copy 1  # true
 765   {
 766     # if w == "+" return true
 767     var subresult/eax: boolean <- word-equal? w, "+"
 768     compare subresult, 0  # false
 769     break-if-!=
 770     # if w == "-" return true
 771     subresult <- word-equal? w, "-"
 772     compare subresult, 0  # false
 773     break-if-!=
 774     # if w == "*" return true
 775     subresult <- word-equal? w, "*"
 776     compare subresult, 0  # false
 777     break-if-!=
 778     # if w == "len" return true
 779     subresult <- word-equal? w, "len"
 780     compare subresult, 0  # false
 781     break-if-!=
 782     # if w == "open" return true
 783     subresult <- word-equal? w, "open"
 784     compare subresult, 0  # false
 785     break-if-!=
 786     # if w == "read" return true
 787     subresult <- word-equal? w, "read"
 788     compare subresult, 0  # false
 789     break-if-!=
 790     # if w == "slurp" return true
 791     subresult <- word-equal? w, "slurp"
 792     compare subresult, 0  # false
 793     break-if-!=
 794     # if w == "lines" return true
 795     subresult <- word-equal? w, "lines"
 796     compare subresult, 0  # false
 797     break-if-!=
 798     # if w == "dup" return true
 799     subresult <- word-equal? w, "dup"
 800     compare subresult, 0  # false
 801     break-if-!=
 802     # if w == "swap" return true
 803     subresult <- word-equal? w, "swap"
 804     compare subresult, 0  # false
 805     break-if-!=
 806     # return w in functions
 807     var out-h: (handle function)
 808     var out/eax: (addr handle function) <- address out-h
 809     callee functions-ah, w, out
 810     var found?/eax: (addr function) <- lookup *out
 811     result <- copy found?
 812   }
 813   return result
 814 }
 815 
 816 fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> _/ebx: boolean {
 817   var f-ah/eax: (addr handle function) <- copy *_f-ah
 818   var f/eax: (addr function) <- lookup *f-ah
 819   var args-ah/eax: (addr handle word) <- get f, args
 820   var result/ebx: boolean <- word-exists? args-ah, arg
 821   return result
 822 }
 823 
 824 # construct a call to `f` with copies of exactly its args
 825 fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) {
 826   var f-ah/eax: (addr handle function) <- copy _f-ah
 827   var _f/eax: (addr function) <- lookup *f-ah
 828   var f/esi: (addr function) <- copy _f
 829   # append args in reverse
 830   var args-ah/eax: (addr handle word) <- get f, args
 831   var dest-ah/edi: (addr handle word) <- copy _dest-ah
 832   copy-words-in-reverse args-ah, dest-ah
 833   # append name
 834   var name-ah/eax: (addr handle array byte) <- get f, name
 835   var name/eax: (addr array byte) <- lookup *name-ah
 836   append-word-at-end-with dest-ah, name
 837 }
 838 
 839 fn word-index _words: (addr handle word), _n: int, out: (addr handle word) {
 840 $word-index:body: {
 841   var n/ecx: int <- copy _n
 842   {
 843     compare n, 0
 844     break-if-!=
 845     copy-object _words, out
 846     break $word-index:body
 847   }
 848   var words-ah/eax: (addr handle word) <- copy _words
 849   var words/eax: (addr word) <- lookup *words-ah
 850   var next/eax: (addr handle word) <- get words, next
 851   n <- decrement
 852   word-index next, n, out
 853 }
 854 }
 855 
 856 fn toggle-cursor-word _sandbox: (addr sandbox) {
 857 $toggle-cursor-word:body: {
 858   var sandbox/esi: (addr sandbox) <- copy _sandbox
 859   var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
 860   var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
 861 #?   print-string 0, "cursor call path: "
 862 #?   dump-call-path-element 0, cursor-call-path
 863 #?   print-string 0, "expanded words:\n"
 864 #?   dump-call-paths 0, expanded-words
 865   var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path
 866   compare already-expanded?, 0  # false
 867   {
 868     break-if-!=
 869 #?     print-string 0, "expand\n"
 870     # if not already-expanded, insert
 871     insert-in-call-path expanded-words cursor-call-path
 872 #?     print-string 0, "expanded words now:\n"
 873 #?     dump-call-paths 0, expanded-words
 874     break $toggle-cursor-word:body
 875   }
 876   {
 877     break-if-=
 878     # otherwise delete
 879     delete-in-call-path expanded-words cursor-call-path
 880   }
 881 }
 882 }
 883 
 884 #############
 885 # Visualize
 886 #############
 887 
 888 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) {
 889   var env/esi: (addr environment) <- copy _env
 890   # functions
 891   var functions/edx: (addr handle function) <- get env, functions
 892   # line
 893   var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes
 894   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
 895   var line-ah/eax: (addr handle line) <- get sandbox, data
 896   var _line/eax: (addr line) <- lookup *line-ah
 897   var line/esi: (addr line) <- copy _line
 898   evaluate functions, 0, line, 0, stack
 899 }
 900 
 901 fn render _env: (addr environment) {
 902 #?   print-string 0, "==\n"
 903   var env/esi: (addr environment) <- copy _env
 904   clear-canvas env
 905   # screen
 906   var screen-ah/eax: (addr handle screen) <- get env, screen
 907   var _screen/eax: (addr screen) <- lookup *screen-ah
 908   var screen/edi: (addr screen) <- copy _screen
 909   # repl-col
 910   var _repl-col/eax: (addr int) <- get env, code-separator-col
 911   var repl-col/ecx: int <- copy *_repl-col
 912   repl-col <- add 2  # repl-margin-left
 913   # functions
 914   var functions/edx: (addr handle function) <- get env, functions
 915   # sandbox
 916   var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes
 917   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
 918 #?   {
 919 #?     var line-ah/eax: (addr handle line) <- get sandbox, data
 920 #?     var line/eax: (addr line) <- lookup *line-ah
 921 #?     var first-word-ah/eax: (addr handle word) <- get line, data
 922 #?     var curr-word/eax: (addr word) <- lookup *first-word-ah
 923 #?     print-word 0, curr-word
 924 #?     print-string 0, "\n"
 925 #?   }
 926   # bindings
 927   var bindings-storage: table
 928   var bindings/ebx: (addr table) <- address bindings-storage
 929   initialize-table bindings, 0x10
 930   render-sandbox screen, functions, bindings, sandbox, 3, repl-col
 931 }
 932 
 933 fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int {
 934   var sandbox/esi: (addr sandbox) <- copy _sandbox
 935   # line
 936   var curr-line-ah/eax: (addr handle line) <- get sandbox, data
 937   var _curr-line/eax: (addr line) <- lookup *curr-line-ah
 938   var curr-line/ecx: (addr line) <- copy _curr-line
 939   #
 940   var curr-row/edx: int <- copy top-row
 941   # cursor row, col
 942   var cursor-row: int
 943   var cursor-row-addr: (addr int)
 944   var tmp/eax: (addr int) <- address cursor-row
 945   copy-to cursor-row-addr, tmp
 946   var cursor-col: int
 947   var cursor-col-addr: (addr int)
 948   tmp <- address cursor-col
 949   copy-to cursor-col-addr, tmp
 950   # render all but final line without stack
 951 #?   print-string 0, "render all but final line\n"
 952   {
 953     var next-line-ah/eax: (addr handle line) <- get curr-line, next
 954     var next-line/eax: (addr line) <- lookup *next-line-ah
 955     compare next-line, 0
 956     break-if-=
 957     {
 958       var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 959       var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 960       var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 961       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 962 #?       print-string 0, "cursor 2: "
 963 #?       {
 964 #?         print-word 0, cursor-word
 965 #?         print-string 0, " -- "
 966 #?         var foo/eax: int <- copy cursor-word
 967 #?         print-int32-hex 0, foo
 968 #?         print-string 0, "\n"
 969 #?       }
 970       # 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
 971       render-line-without-stack screen, curr-line, curr-row, left-col, cursor-word, cursor-row-addr, cursor-col-addr
 972     }
 973     curr-line <- copy next-line
 974     curr-row <- add 2
 975     loop
 976   }
 977   #
 978 #?   print-string 0, "render final line\n"
 979   render-final-line-with-stack screen, functions, bindings, sandbox, curr-row, left-col, cursor-row-addr, cursor-col-addr
 980   # at most one of the following dialogs will be rendered
 981   render-rename-dialog screen, sandbox, cursor-row, cursor-col
 982   render-define-dialog screen, sandbox, cursor-row, cursor-col
 983   move-cursor screen, cursor-row, cursor-col
 984 }
 985 
 986 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) {
 987   var sandbox/esi: (addr sandbox) <- copy _sandbox
 988   # expanded-words
 989   var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
 990   # cursor-word
 991   var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 992   var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah
 993   var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word
 994   var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 995   var cursor-word/ebx: (addr word) <- copy _cursor-word
 996 #?   print-string 0, "word at cursor: "
 997 #?   print-word 0, cursor-word
 998 #?   print-string 0, "\n"
 999   # cursor-call-path
1000   var cursor-call-path: (addr handle call-path-element)
1001   {
1002     var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
1003     copy-to cursor-call-path, src
1004   }
1005   # first line
1006   var first-line-ah/eax: (addr handle line) <- get sandbox, data
1007   var _first-line/eax: (addr line) <- lookup *first-line-ah
1008   var first-line/edx: (addr line) <- copy _first-line
1009   # final line
1010   var final-line-storage: (handle line)
1011   var final-line-ah/eax: (addr handle line) <- address final-line-storage
1012   final-line sandbox, final-line-ah
1013   var final-line/eax: (addr line) <- lookup *final-line-ah
1014   # curr-path
1015   var curr-path-storage: (handle call-path-element)
1016   var curr-path/ecx: (addr handle call-path-element) <- address curr-path-storage
1017   allocate curr-path  # leak
1018   initialize-path-from-line final-line, curr-path
1019   #
1020   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
1021 }
1022 
1023 fn final-line _sandbox: (addr sandbox), out: (addr handle line) {
1024   var sandbox/esi: (addr sandbox) <- copy _sandbox
1025   var curr-line-ah/ecx: (addr handle line) <- get sandbox, data
1026   {
1027     var curr-line/eax: (addr line) <- lookup *curr-line-ah
1028     var next-line-ah/edx: (addr handle line) <- get curr-line, next
1029     var next-line/eax: (addr line) <- lookup *next-line-ah
1030     compare next-line, 0
1031     break-if-=
1032     curr-line-ah <- copy next-line-ah
1033     loop
1034   }
1035   copy-object curr-line-ah, out
1036 }
1037 
1038 fn render-rename-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int {
1039   var sandbox/edi: (addr sandbox) <- copy _sandbox
1040   var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
1041   var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah?
1042   compare rename-word-mode?, 0
1043   break-if-=
1044   # clear a space for the dialog
1045   var top-row/eax: int <- copy cursor-row
1046   top-row <- subtract 3
1047   var bottom-row/ecx: int <- copy cursor-row
1048   bottom-row <- add 3
1049   var left-col/edx: int <- copy cursor-col
1050   left-col <- subtract 0x10
1051   var right-col/ebx: int <- copy cursor-col
1052   right-col <- add 0x10
1053   clear-rect screen, top-row, left-col, bottom-row, right-col
1054   draw-box screen, top-row, left-col, bottom-row, right-col
1055   # render a little menu for the dialog
1056   var menu-row/ecx: int <- copy bottom-row
1057   menu-row <- decrement
1058   var menu-col/edx: int <- copy left-col
1059   menu-col <- add 2
1060   move-cursor screen, menu-row, menu-col
1061   start-reverse-video screen
1062   print-string screen, " esc "
1063   reset-formatting screen
1064   print-string screen, " cancel  "
1065   start-reverse-video screen
1066   print-string screen, " enter "
1067   reset-formatting screen
1068   print-string screen, " rename  "
1069   # draw the word, positioned appropriately around the cursor
1070   var start-col/ecx: int <- copy cursor-col
1071   var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word
1072   var word/eax: (addr word) <- lookup *word-ah?
1073   var cursor-index/eax: int <- cursor-index word
1074   start-col <- subtract cursor-index
1075   move-cursor screen, cursor-row, start-col
1076   var word/eax: (addr word) <- lookup *word-ah?
1077   print-word screen, word
1078 }
1079 
1080 fn render-define-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int {
1081   var sandbox/edi: (addr sandbox) <- copy _sandbox
1082   var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function
1083   var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah?
1084   compare define-function-mode?, 0
1085   break-if-=
1086   # clear a space for the dialog
1087   var top-row/eax: int <- copy cursor-row
1088   top-row <- subtract 3
1089   var bottom-row/ecx: int <- copy cursor-row
1090   bottom-row <- add 3
1091   var left-col/edx: int <- copy cursor-col
1092   left-col <- subtract 0x10
1093   var right-col/ebx: int <- copy cursor-col
1094   right-col <- add 0x10
1095   clear-rect screen, top-row, left-col, bottom-row, right-col
1096   draw-box screen, top-row, left-col, bottom-row, right-col
1097   # render a little menu for the dialog
1098   var menu-row/ecx: int <- copy bottom-row
1099   menu-row <- decrement
1100   var menu-col/edx: int <- copy left-col
1101   menu-col <- add 2
1102   move-cursor screen, menu-row, menu-col
1103   start-reverse-video screen
1104   print-string screen, " esc "
1105   reset-formatting screen
1106   print-string screen, " cancel  "
1107   start-reverse-video screen
1108   print-string screen, " enter "
1109   reset-formatting screen
1110   print-string screen, " define  "
1111   # draw the word, positioned appropriately around the cursor
1112   var start-col/ecx: int <- copy cursor-col
1113   var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function
1114   var word/eax: (addr word) <- lookup *word-ah?
1115   var cursor-index/eax: int <- cursor-index word
1116   start-col <- subtract cursor-index
1117   move-cursor screen, cursor-row, start-col
1118   var word/eax: (addr word) <- lookup *word-ah?
1119   print-word screen, word
1120 }
1121 
1122 # Render just the words in 'line'.
1123 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) {
1124   # curr-word
1125   var line/eax: (addr line) <- copy _line
1126   var first-word-ah/eax: (addr handle word) <- get line, data
1127   var _curr-word/eax: (addr word) <- lookup *first-word-ah
1128   var curr-word/esi: (addr word) <- copy _curr-word
1129   #
1130   # loop-carried dependency
1131   var curr-col/ecx: int <- copy left-col
1132   #
1133   {
1134     compare curr-word, 0
1135     break-if-=
1136 #?     print-string 0, "-- word in penultimate lines: "
1137 #?     {
1138 #?       var foo/eax: int <- copy curr-word
1139 #?       print-int32-hex 0, foo
1140 #?     }
1141 #?     print-string 0, "\n"
1142     var old-col/edx: int <- copy curr-col
1143     reset-formatting screen
1144     move-cursor screen, curr-row, curr-col
1145     print-word screen, curr-word
1146     {
1147       var max-width/eax: int <- word-length curr-word
1148       curr-col <- add max-width
1149       curr-col <- add 1  # margin-right
1150     }
1151     # cache cursor column if necessary
1152     {
1153       compare curr-word, cursor-word
1154       break-if-!=
1155 #?       print-string 0, "Cursor at "
1156 #?       print-int32-decimal 0, curr-row
1157 #?       print-string 0, ", "
1158 #?       print-int32-decimal 0, old-col
1159 #?       print-string 0, "\n"
1160 #?       print-string 0, "contents: "
1161 #?       print-word 0, cursor-word
1162 #?       print-string 0, "\n"
1163 #?       {
1164 #?         var foo/eax: int <- copy cursor-word
1165 #?         print-int32-hex 0, foo
1166 #?         print-string 0, "\n"
1167 #?       }
1168       var dest/ecx: (addr int) <- copy cursor-row-addr
1169       var src/eax: int <- copy curr-row
1170       copy-to *dest, src
1171       dest <- copy cursor-col-addr
1172       copy-to *dest, old-col
1173       var cursor-index-in-word/eax: int <- cursor-index curr-word
1174       add-to *dest, cursor-index-in-word
1175     }
1176     # loop update
1177     var next-word-ah/edx: (addr handle word) <- get curr-word, next
1178     var _curr-word/eax: (addr word) <- lookup *next-word-ah
1179     curr-word <- copy _curr-word
1180     loop
1181   }
1182 }
1183 
1184 fn call-depth-at-cursor _sandbox: (addr sandbox) -> _/eax: int {
1185   var sandbox/esi: (addr sandbox) <- copy _sandbox
1186   var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path
1187   var result/eax: int <- call-path-element-length cursor-call-path
1188   result <- add 2  # input-row - 1
1189   return result
1190 }
1191 
1192 fn call-path-element-length _x: (addr handle call-path-element) -> _/eax: int {
1193   var curr-ah/ecx: (addr handle call-path-element) <- copy _x
1194   var result/edi: int <- copy 0
1195   {
1196     var curr/eax: (addr call-path-element) <- lookup *curr-ah
1197     compare curr, 0
1198     break-if-=
1199     curr-ah <- get curr, next
1200     result <- increment
1201     loop
1202   }
1203   return result
1204 }
1205 
1206 # Render the line of words in line, along with the state of the stack under each word.
1207 # Also render any expanded function calls using recursive calls.
1208 #
1209 # Along the way, compute the column the cursor should be positioned at (cursor-col-addr).
1210 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 {
1211 #?   print-string 0, "--\n"
1212   # curr-word
1213   var line/esi: (addr line) <- copy _line
1214   var first-word-ah/eax: (addr handle word) <- get line, data
1215   var curr-word/eax: (addr word) <- lookup *first-word-ah
1216   var debug-row: int
1217   copy-to debug-row, 0x20
1218   #
1219   # loop-carried dependency
1220   var curr-col/ecx: int <- copy left-col
1221   #
1222   {
1223     compare curr-word, 0
1224     break-if-=
1225 #?     print-string 0, "-- word in final line: "
1226 #?     {
1227 #?       var foo/eax: int <- copy curr-word
1228 #?       print-int32-hex 0, foo
1229 #?     }
1230 #?     print-string 0, "\n"
1231     # if necessary, first render columns for subsidiary stack
1232     $render-line:subsidiary: {
1233       {
1234 #?         print-string 0, "check sub\n"
1235         var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path
1236         compare display-subsidiary-stack?, 0  # false
1237         break-if-= $render-line:subsidiary
1238       }
1239 #?       print-string 0, "render subsidiary stack\n"
1240       # does function exist?
1241       var callee/edi: (addr function) <- copy 0
1242       {
1243         var callee-h: (handle function)
1244         var callee-ah/ecx: (addr handle function) <- address callee-h
1245         callee functions, curr-word, callee-ah
1246         var _callee/eax: (addr function) <- lookup *callee-ah
1247         callee <- copy _callee
1248         compare callee, 0
1249         break-if-= $render-line:subsidiary
1250       }
1251       move-cursor screen, top-row, curr-col
1252       start-color screen, 8, 7
1253       print-word screen, curr-word
1254       {
1255         var word-len/eax: int <- word-length curr-word
1256         curr-col <- add word-len
1257         curr-col <- add 2
1258         increment top-row
1259       }
1260       # obtain stack at call site
1261       var stack-storage: value-stack
1262       var stack/edx: (addr value-stack) <- address stack-storage
1263       initialize-value-stack stack, 0x10
1264       {
1265         var prev-word-ah/eax: (addr handle word) <- get curr-word, prev
1266         var prev-word/eax: (addr word) <- lookup *prev-word-ah
1267         compare prev-word, 0
1268         break-if-=
1269         evaluate functions, bindings, line, prev-word, stack
1270       }
1271       # construct new bindings
1272       var callee-bindings-storage: table
1273       var callee-bindings/esi: (addr table) <- address callee-bindings-storage
1274       initialize-table callee-bindings, 0x10
1275       bind-args callee, stack, callee-bindings
1276       # obtain body
1277       var callee-body-ah/eax: (addr handle line) <- get callee, body
1278       var callee-body/eax: (addr line) <- lookup *callee-body-ah
1279       var callee-body-first-word/edx: (addr handle word) <- get callee-body, data
1280       # - render subsidiary stack
1281       push-to-call-path-element curr-path, callee-body-first-word  # leak
1282       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
1283       drop-from-call-path-element curr-path
1284       #
1285       move-cursor screen, top-row, curr-col
1286       print-code-point screen, 0x21d7  # ⇗
1287       #
1288       curr-col <- add 2
1289       decrement top-row
1290     }
1291     # render main column
1292     var old-col/edx: int <- copy curr-col
1293 #?     move-cursor 0, debug-row, 1
1294 #?     increment debug-row
1295 #?     print-string 0, "rendering column from "
1296 #?     print-int32-decimal 0, curr-col
1297 #?     print-string 0, "\n"
1298     curr-col <- render-column screen, functions, bindings, first-line, line, curr-word, top-row, curr-col
1299     # cache cursor column if necessary
1300     $render-line:cache-cursor-column: {
1301 #?       print-string 0, "cache cursor? "
1302 #?       {
1303 #?         var foo/eax: int <- copy curr-word
1304 #?         print-int32-hex 0, foo
1305 #?       }
1306 #?       print-string 0, "\n"
1307       {
1308         var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path
1309         compare found?, 0  # false
1310         break-if-= $render-line:cache-cursor-column
1311       }
1312 #?       print-string 0, "cursor at "
1313 #?       print-int32-decimal 0, top-row
1314 #?       print-string 0, ", "
1315 #?       print-int32-decimal 0, old-col
1316 #?       print-string 0, "\n"
1317       var dest/edi: (addr int) <- copy cursor-row-addr
1318       {
1319         var src/eax: int <- copy top-row
1320         copy-to *dest, src
1321       }
1322       dest <- copy cursor-col-addr
1323       copy-to *dest, old-col
1324       var cursor-index-in-word/eax: int <- cursor-index curr-word
1325       add-to *dest, cursor-index-in-word
1326     }
1327     # loop update
1328 #?     print-string 0, "next word\n"
1329     var next-word-ah/edx: (addr handle word) <- get curr-word, next
1330     curr-word <- lookup *next-word-ah
1331 #?     {
1332 #?       var foo/eax: int <- copy curr-word
1333 #?       print-int32-hex 0, foo
1334 #?       print-string 0, "\n"
1335 #?     }
1336     increment-final-element curr-path
1337     loop
1338   }
1339   return curr-col
1340 }
1341 
1342 fn callee functions: (addr handle function), word: (addr word), out: (addr handle function) {
1343   var stream-storage: (stream byte 0x10)
1344   var stream/esi: (addr stream byte) <- address stream-storage
1345   emit-word word, stream
1346   find-function functions, stream, out
1347 }
1348 
1349 # Render:
1350 #   - starting at top-row, left-col: final-word
1351 #   - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive)
1352 #
1353 # Return the farthest column written.
1354 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 {
1355 #?   print-string 0, "render-column\n"
1356   var max-width/esi: int <- copy 0
1357   {
1358     # indent stack
1359     var indented-col/ebx: int <- copy left-col
1360     indented-col <- add 1  # margin-right
1361     # compute stack
1362     var stack: value-stack
1363     var stack-addr/edi: (addr value-stack) <- address stack
1364     initialize-value-stack stack-addr, 0x10  # max-words
1365     evaluate functions, bindings, first-line, final-word, stack-addr
1366     # render stack
1367     var curr-row/edx: int <- copy top-row
1368     curr-row <- add 2  # stack-margin-top
1369     var _max-width/eax: int <- value-stack-max-width stack-addr
1370     max-width <- copy _max-width
1371     {
1372       var top-addr/ecx: (addr int) <- get stack-addr, top
1373       compare *top-addr, 0
1374       break-if-<=
1375       decrement *top-addr
1376       move-cursor screen, curr-row, indented-col
1377       {
1378         var data-ah/eax: (addr handle array value) <- get stack-addr, data
1379         var data/eax: (addr array value) <- lookup *data-ah
1380         var top/edx: int <- copy *top-addr
1381         var dest-offset/edx: (offset value) <- compute-offset data, top
1382         var val/eax: (addr value) <- index data, dest-offset
1383         render-value screen, val, max-width
1384       }
1385       curr-row <- increment
1386       loop
1387     }
1388   }
1389 
1390   max-width <- add 2  # spaces on either side of items on the stack
1391 
1392   # render word, initialize result
1393   reset-formatting screen
1394   move-cursor screen, top-row, left-col
1395   print-word screen, final-word
1396   {
1397     var size/eax: int <- word-length final-word
1398     compare size, max-width
1399     break-if-<=
1400     max-width <- copy size
1401   }
1402 
1403   # post-process right-col
1404   var right-col/ecx: int <- copy left-col
1405   right-col <- add max-width
1406   right-col <- add 1  # margin-right
1407 #?   print-int32-decimal 0, left-col
1408 #?   print-string 0, " => "
1409 #?   print-int32-decimal 0, right-col
1410 #?   print-string 0, "\n"
1411   return right-col
1412 }
1413 
1414 fn render-value screen: (addr screen), _val: (addr value), max-width: int {
1415 $render-value:body: {
1416   var val/esi: (addr value) <- copy _val
1417   var val-type/ecx: (addr int) <- get val, type
1418   # per-type rendering logic goes here
1419   compare *val-type, 1  # string
1420   {
1421     break-if-!=
1422     var val-ah/eax: (addr handle array byte) <- get val, text-data
1423     var val-string/eax: (addr array byte) <- lookup *val-ah
1424     compare val-string, 0
1425     break-if-=
1426     var orig-len/ecx: int <- length val-string
1427     var truncated: (handle array byte)
1428     var truncated-ah/esi: (addr handle array byte) <- address truncated
1429     substring val-string, 0, 0xc, truncated-ah
1430     var truncated-string/eax: (addr array byte) <- lookup *truncated-ah
1431 #?     {
1432 #?       var foo/eax: int <- copy truncated-string
1433 #?       print-int32-hex 0, foo
1434 #?       print-string 0, "\n"
1435 #?     }
1436     var len/edx: int <- length truncated-string
1437     start-color screen, 0xf2, 7
1438     print-code-point screen, 0x275d  # open-quote
1439     print-string screen, truncated-string
1440     compare len, orig-len
1441     {
1442       break-if-=
1443       print-code-point screen, 0x2026  # ellipses
1444     }
1445     print-code-point screen, 0x275e  # close-quote
1446     reset-formatting screen
1447     break $render-value:body
1448   }
1449   compare *val-type, 2  # array
1450   {
1451     break-if-!=
1452     var val-ah/eax: (addr handle array value) <- get val, array-data
1453     var val-array/eax: (addr array value) <- lookup *val-ah
1454     render-array screen, val-array
1455     break $render-value:body
1456   }
1457   compare *val-type, 3  # file
1458   {
1459     break-if-!=
1460     var val-ah/eax: (addr handle buffered-file) <- get val, file-data
1461     var val-file/eax: (addr buffered-file) <- lookup *val-ah
1462     start-color screen, 0, 7
1463     # TODO
1464     print-string screen, " FILE "
1465     break $render-value:body
1466   }
1467   # render ints by default for now
1468   var val-int/eax: (addr int) <- get val, int-data
1469   render-integer screen, *val-int, max-width
1470 }
1471 }
1472 
1473 # synaesthesia
1474 fn render-integer screen: (addr screen), val: int, max-width: int {
1475 $render-integer:body: {
1476   # if max-width is 0, we're inside an array. No coloring.
1477   compare max-width, 0
1478   {
1479     break-if-!=
1480     print-int32-decimal screen, val
1481     break $render-integer:body
1482   }
1483   var bg/eax: int <- hash-color val
1484   var fg/ecx: int <- copy 7
1485   {
1486     compare bg, 2
1487     break-if-!=
1488     fg <- copy 0
1489   }
1490   {
1491     compare bg, 3
1492     break-if-!=
1493     fg <- copy 0
1494   }
1495   {
1496     compare bg, 6
1497     break-if-!=
1498     fg <- copy 0
1499   }
1500   start-color screen, fg, bg
1501   print-grapheme screen, 0x20  # space
1502   print-int32-decimal-right-justified screen, val, max-width
1503   print-grapheme screen, 0x20  # space
1504 }
1505 }
1506 
1507 fn render-array screen: (addr screen), _a: (addr array value) {
1508   start-color screen, 0xf2, 7
1509   # don't surround in spaces
1510   print-grapheme screen, 0x5b  # '['
1511   var a/esi: (addr array value) <- copy _a
1512   var max/ecx: int <- length a
1513   var i/eax: int <- copy 0
1514   {
1515     compare i, max
1516     break-if->=
1517     {
1518       compare i, 0
1519       break-if-=
1520       print-string screen, " "
1521     }
1522     var off/ecx: (offset value) <- compute-offset a, i
1523     var x/ecx: (addr value) <- index a, off
1524     render-value screen, x, 0
1525     i <- increment
1526     loop
1527   }
1528   print-grapheme screen, 0x5d  # ']'
1529 }
1530 
1531 fn hash-color val: int -> _/eax: int {
1532   var result/eax: int <- try-modulo val, 7  # assumes that 7 is always the background color
1533   return result
1534 }
1535 
1536 fn clear-canvas _env: (addr environment) {
1537   var env/esi: (addr environment) <- copy _env
1538   var screen-ah/edi: (addr handle screen) <- get env, screen
1539   var _screen/eax: (addr screen) <- lookup *screen-ah
1540   var screen/edi: (addr screen) <- copy _screen
1541   clear-screen screen
1542   var nrows/eax: (addr int) <- get env, nrows
1543   var _repl-col/ecx: (addr int) <- get env, code-separator-col
1544   var repl-col/ecx: int <- copy *_repl-col
1545   draw-vertical-line screen, 1, *nrows, repl-col
1546   # wordstar-style cheatsheet of shortcuts
1547   move-cursor screen, *nrows, 0
1548   start-reverse-video screen
1549   print-string screen, " ctrl-q "
1550   reset-formatting screen
1551   print-string screen, " quit "
1552   var menu-start/ebx: int <- copy repl-col
1553   menu-start <- subtract 0x40  # 64 = half the size of the menu
1554   move-cursor screen, *nrows, menu-start
1555   start-reverse-video screen
1556   print-string screen, " ctrl-a "
1557   reset-formatting screen
1558   print-string screen, " ⏮   "
1559   start-reverse-video screen
1560   print-string screen, " ctrl-b "
1561   reset-formatting screen
1562   print-string screen, " ◀ word  "
1563   start-reverse-video screen
1564   print-string screen, " ctrl-f "
1565   reset-formatting screen
1566   print-string screen, " word ▶  "
1567   start-reverse-video screen
1568   print-string screen, " ctrl-e "
1569   reset-formatting screen
1570   print-string screen, " ⏭   "
1571   start-reverse-video screen
1572   print-string screen, " ctrl-u "
1573   reset-formatting screen
1574   print-string screen, " clear line  "
1575   start-reverse-video screen
1576   print-string screen, " ctrl-n "
1577   reset-formatting screen
1578   print-string screen, " name value  "
1579   start-reverse-video screen
1580   print-string screen, " ctrl-d "
1581   reset-formatting screen
1582   print-string screen, " define function  "
1583   # primitives
1584   var start-col/ecx: int <- copy repl-col
1585   start-col <- subtract 0x20
1586   move-cursor screen, 1, start-col
1587   print-string screen, "primitives:"
1588   start-col <- add 2
1589   move-cursor screen, 2, start-col
1590   print-string screen, "+ - * len"
1591   move-cursor screen, 3, start-col
1592   print-string screen, "open read slurp lines"
1593   move-cursor screen, 4, start-col
1594   print-string screen, "dup swap"
1595   # currently defined functions
1596   start-col <- subtract 2
1597   move-cursor screen, 6, start-col
1598   print-string screen, "functions:"
1599   start-col <- add 2
1600   var row/ebx: int <- copy 7
1601   var functions/esi: (addr handle function) <- get env, functions
1602   {
1603     var curr/eax: (addr function) <- lookup *functions
1604     compare curr, 0
1605     break-if-=
1606     row <- render-function screen, row, start-col, curr
1607     functions <- get curr, next
1608     row <- increment
1609     loop
1610   }
1611 }
1612 
1613 # only single-line functions supported for now
1614 fn render-function screen: (addr screen), row: int, col: int, _f: (addr function) -> _/ebx: int {
1615   var f/esi: (addr function) <- copy _f
1616   var args/ecx: (addr handle word) <- get f, args
1617   move-cursor screen, row, col
1618   print-words-in-reverse screen, args
1619   var name-ah/eax: (addr handle array byte) <- get f, name
1620   var name/eax: (addr array byte) <- lookup *name-ah
1621   start-bold screen
1622   print-string screen, name
1623   reset-formatting screen
1624   increment row
1625   add-to col, 2
1626   move-cursor screen, row, col
1627   print-string screen, "= "
1628   var body-ah/eax: (addr handle line) <- get f, body
1629   var body/eax: (addr line) <- lookup *body-ah
1630   var body-words-ah/eax: (addr handle word) <- get body, data
1631   print-words screen, body-words-ah
1632   return row
1633 }
1634 
1635 fn real-grapheme? g: grapheme -> _/eax: boolean {
1636   # if g == newline return true
1637   compare g, 0xa
1638   {
1639     break-if-!=
1640     return 1  # true
1641   }
1642   # if g == tab return true
1643   compare g, 9
1644   {
1645     break-if-!=
1646     return 1  # true
1647   }
1648   # if g < 32 return false
1649   compare g, 0x20
1650   {
1651     break-if->=
1652     return 0  # false
1653   }
1654   # if g <= 255 return true
1655   compare g, 0xff
1656   {
1657     break-if->
1658     return 1  # true
1659   }
1660   # if (g&0xff == Esc) it's an escape sequence
1661   and-with g, 0xff
1662   compare g, 0x1b  # Esc
1663   {
1664     break-if-!=
1665     return 0  # false
1666   }
1667   # otherwise return true
1668   return 1  # true
1669 }