1 type environment {
  2   screen: (handle screen)
  3   program: (handle program)
  4   cursor-word: (handle word)
  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   var program-ah/eax: (addr handle program) <- get env, program
 13   allocate program-ah
 14   var program/eax: (addr program) <- lookup *program-ah
 15   var cursor-word-ah/ecx: (addr handle word) <- get env, cursor-word
 16   initialize-program program, cursor-word-ah
 17   # initialize screen
 18   var screen-ah/eax: (addr handle screen) <- get env, screen
 19   var _screen/eax: (addr screen) <- lookup *screen-ah
 20   var screen/edi: (addr screen) <- copy _screen
 21   var nrows/eax: int <- copy 0
 22   var ncols/ecx: int <- copy 0
 23   nrows, ncols <- screen-size screen
 24   var dest/edx: (addr int) <- get env, nrows
 25   copy-to *dest, nrows
 26   dest <- get env, ncols
 27   copy-to *dest, ncols
 28   var repl-col/ecx: int <- copy ncols
 29   repl-col <- shift-right 1
 30   dest <- get env, code-separator-col
 31   copy-to *dest, repl-col
 32 }
 33 
 34 fn draw-screen _env: (addr environment) {
 35   var env/esi: (addr environment) <- copy _env
 36   var screen-ah/eax: (addr handle screen) <- get env, screen
 37   var _screen/eax: (addr screen) <- lookup *screen-ah
 38   var screen/edi: (addr screen) <- copy _screen
 39   var dest/edx: (addr int) <- get env, code-separator-col
 40   var tmp/eax: int <- copy *dest
 41   clear-canvas env
 42   tmp <- add 2  # repl-margin-left
 43   move-cursor screen, 3, tmp  # input-row
 44 }
 45 
 46 fn initialize-environment-with-fake-screen _self: (addr environment), nrows: int, ncols: int {
 47   var self/esi: (addr environment) <- copy _self
 48   var screen-ah/eax: (addr handle screen) <- get self, screen
 49   allocate screen-ah
 50   var screen-addr/eax: (addr screen) <- lookup *screen-ah
 51   initialize-screen screen-addr, nrows, ncols
 52   initialize-environment self
 53 }
 54 
 55 fn process _self: (addr environment), key: grapheme {
 56 $process:body: {
 57     var self/esi: (addr environment) <- copy _self
 58     compare key, 0x445b1b  # left-arrow
 59     {
 60       break-if-!=
 61       var cursor-word-ah/edi: (addr handle word) <- get self, cursor-word
 62       var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 63       var cursor-word/ecx: (addr word) <- copy _cursor-word
 64       # if not at start, move left within current word
 65       var at-start?/eax: boolean <- cursor-at-start? cursor-word
 66       compare at-start?, 0  # false
 67       {
 68         break-if-=
 69         cursor-left cursor-word
 70         break $process:body
 71       }
 72       # otherwise, move to end of prev word
 73       var prev-word-ah/esi: (addr handle word) <- get cursor-word, prev
 74       var prev-word/eax: (addr word) <- lookup *prev-word-ah
 75       {
 76         compare prev-word, 0
 77         break-if-=
 78         copy-object prev-word-ah, cursor-word-ah
 79         cursor-to-end prev-word
 80       }
 81       break $process:body
 82     }
 83     compare key, 0x435b1b  # right-arrow
 84     {
 85       break-if-!=
 86       var cursor-word-ah/edi: (addr handle word) <- get self, cursor-word
 87       var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
 88       var cursor-word/ecx: (addr word) <- copy _cursor-word
 89       # if not at end, move right within current word
 90       var at-end?/eax: boolean <- cursor-at-end? cursor-word
 91       compare at-end?, 0  # false
 92       {
 93         break-if-=
 94         cursor-right cursor-word
 95         break $process:body
 96       }
 97       # otherwise, move to start of next word
 98       var next-word-ah/esi: (addr handle word) <- get cursor-word, next
 99       var next-word/eax: (addr word) <- lookup *next-word-ah
100       {
101         compare next-word, 0
102         break-if-=
103         copy-object next-word-ah, cursor-word-ah
104         cursor-to-start next-word
105       }
106       break $process:body
107     }
108     compare key, 0x7f  # del (backspace on Macs)
109     {
110       break-if-!=
111       var cursor-word-ah/edi: (addr handle word) <- get self, cursor-word
112       var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
113       var cursor-word/ecx: (addr word) <- copy _cursor-word
114       # if not at start of some word, delete grapheme before cursor within current word
115       var at-start?/eax: boolean <- cursor-at-start? cursor-word
116       compare at-start?, 0  # false
117       {
118         break-if-=
119         delete-before-cursor cursor-word
120         break $process:body
121       }
122       # otherwise delete current word and move to end of prev word
123       var prev-word-ah/esi: (addr handle word) <- get cursor-word, prev
124       var prev-word/eax: (addr word) <- lookup *prev-word-ah
125       {
126         compare prev-word, 0
127         break-if-=
128         copy-object prev-word-ah, cursor-word-ah
129         cursor-to-end prev-word
130         delete-next prev-word
131       }
132       break $process:body
133     }
134     compare key, 0x20  # space
135     {
136       break-if-!=
137       # insert new word
138       var cursor-word-ah/edx: (addr handle word) <- get self, cursor-word
139       append-word cursor-word-ah
140       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
141       var next-word-ah/ecx: (addr handle word) <- get cursor-word, next
142       copy-object next-word-ah, cursor-word-ah
143       break $process:body
144     }
145     compare key, 0xa  # enter
146     {
147       break-if-!=
148       # toggle display of subsidiary stack
149       var cursor-word-ah/edx: (addr handle word) <- get self, cursor-word
150       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
151       var display-subsidiary-stack?/eax: (addr boolean) <- get cursor-word, display-subsidiary-stack?
152       var tmp/ecx: int <- copy 1
153       tmp <- subtract *display-subsidiary-stack?
154       copy-to *display-subsidiary-stack?, tmp
155       break $process:body
156     }
157     # otherwise insert key within current word
158     var g/edx: grapheme <- copy key
159     var print?/eax: boolean <- real-grapheme? key
160     {
161       compare print?, 0  # false
162       break-if-=
163       var cursor-word-ah/eax: (addr handle word) <- get self, cursor-word
164       var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
165       add-grapheme-to-word cursor-word, g
166       break $process:body
167     }
168     # silently ignore other hotkeys
169 }
170 }
171 
172 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) {
173   var env/esi: (addr environment) <- copy _env
174   # program
175   var program-ah/eax: (addr handle program) <- get env, program
176   var _program/eax: (addr program) <- lookup *program-ah
177   var program/esi: (addr program) <- copy _program
178   # defs
179   var defs/edx: (addr handle function) <- get program, defs
180   # line
181   var sandbox-ah/esi: (addr handle sandbox) <- get program, sandboxes
182   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
183   var line-ah/eax: (addr handle line) <- get sandbox, data
184   var _line/eax: (addr line) <- lookup *line-ah
185   var line/esi: (addr line) <- copy _line
186   evaluate defs, 0, line, 0, stack
187 }
188 
189 fn render _env: (addr environment) {
190   var env/esi: (addr environment) <- copy _env
191   clear-canvas env
192   var screen-ah/edi: (addr handle screen) <- get env, screen
193   var _screen/eax: (addr screen) <- lookup *screen-ah
194   var screen/edi: (addr screen) <- copy _screen
195   var _repl-col/ecx: (addr int) <- get env, code-separator-col
196   var repl-col/ecx: int <- copy *_repl-col
197   repl-col <- add 2  # repl-margin-left
198   # cursor-word
199   var cursor-word-ah/ebx: (addr handle word) <- get env, cursor-word
200   var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
201   var cursor-word/ebx: (addr word) <- copy _cursor-word
202   # program
203   var program-ah/eax: (addr handle program) <- get env, program
204   var _program/eax: (addr program) <- lookup *program-ah
205   var program/esi: (addr program) <- copy _program
206   # defs
207   var defs/edx: (addr handle function) <- get program, defs
208   # line
209   var sandbox-ah/esi: (addr handle sandbox) <- get program, sandboxes
210   var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
211   var line-ah/eax: (addr handle line) <- get sandbox, data
212   var _line/eax: (addr line) <- lookup *line-ah
213   var line/esi: (addr line) <- copy _line
214   # cursor-col
215   var cursor-col: int
216   var cursor-col-a/eax: (addr int) <- address cursor-col
217   #
218   var dummy/ecx: int <- render-line screen, defs, 0, line, 3, repl-col, cursor-word, cursor-col-a  # input-row=3
219   move-cursor screen, 3, cursor-col  # input-row
220 }
221 
222 fn render-line screen: (addr screen), defs: (addr handle function), bindings: (addr table), _line: (addr line), top-row: int, left-col: int, cursor-word: (addr word), cursor-col-a: (addr int) -> right-col/ecx: int {
223   # curr-word
224   var line/esi: (addr line) <- copy _line
225   var first-word-ah/eax: (addr handle word) <- get line, data
226   var curr-word/eax: (addr word) <- lookup *first-word-ah
227   # loop-carried dependency
228   var curr-col/ecx: int <- copy left-col
229   #
230   {
231     compare curr-word, 0
232     break-if-=
233     # if necessary, first render columns for subsidiary stack
234     $render-line:subsidiary: {
235       {
236         var display-subsidiary-stack?/eax: (addr boolean) <- get curr-word, display-subsidiary-stack?
237         compare *display-subsidiary-stack?, 0  # false
238         break-if-= $render-line:subsidiary
239       }
240       # does function exist?
241       var callee/edi: (addr function) <- copy 0
242       {
243         var curr-stream-storage: (stream byte 0x10)
244         var curr-stream/esi: (addr stream byte) <- address curr-stream-storage
245         emit-word curr-word, curr-stream
246         var callee-h: (handle function)
247         var callee-ah/eax: (addr handle function) <- address callee-h
248         find-function defs, curr-stream, callee-ah
249         var _callee/eax: (addr function) <- lookup *callee-ah
250         callee <- copy _callee
251         compare callee, 0
252         break-if-= $render-line:subsidiary
253       }
254       move-cursor screen, top-row, curr-col
255       print-word screen, curr-word
256       {
257         var word-len/eax: int <- word-length curr-word
258         curr-col <- add word-len
259         curr-col <- add 2
260         add-to top-row, 1
261       }
262       # obtain stack at call site
263       var stack-storage: value-stack
264       var stack/edx: (addr value-stack) <- address stack-storage
265       initialize-value-stack stack, 0x10
266       {
267         var prev-word-ah/eax: (addr handle word) <- get curr-word, prev
268         var prev-word/eax: (addr word) <- lookup *prev-word-ah
269         compare prev-word, 0
270         break-if-=
271         evaluate defs, bindings, line, prev-word, stack
272       }
273       # construct new bindings
274       var callee-bindings-storage: table
275       var callee-bindings/esi: (addr table) <- address callee-bindings-storage
276       initialize-table callee-bindings, 0x10
277       bind-args callee, stack, callee-bindings
278       # obtain body
279       var callee-body-ah/eax: (addr handle line) <- get callee, body
280       var callee-body/eax: (addr line) <- lookup *callee-body-ah
281       # - render subsidiary stack
282       curr-col <- render-line screen, defs, callee-bindings, callee-body, top-row, curr-col, cursor-word, cursor-col-a
283       #
284       move-cursor screen, top-row, curr-col
285       print-code-point screen, 0x21d7  # ⇗
286       #
287       curr-col <- add 2
288       subtract-from top-row, 1
289     }
290     # now render main column
291     curr-col <- render-column screen, defs, bindings, line, curr-word, top-row, curr-col, cursor-word, cursor-col-a
292     var next-word-ah/edx: (addr handle word) <- get curr-word, next
293     curr-word <- lookup *next-word-ah
294     loop
295   }
296   right-col <- copy curr-col
297 }
298 
299 # Render:
300 #   - starting at top-row, left-col: final-word
301 #   - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive)
302 #     unless final-word is truly the final word, in which case it might be incomplete
303 #
304 # Outputs:
305 # - Return the farthest column written.
306 # - If final-word is same as cursor-word, do some additional computation to set
307 #   cursor-col-a.
308 fn render-column screen: (addr screen), defs: (addr handle function), bindings: (addr table), scratch: (addr line), final-word: (addr word), top-row: int, left-col: int, cursor-word: (addr word), cursor-col-a: (addr int) -> right-col/ecx: int {
309   var max-width/ecx: int <- copy 0
310   {
311     # indent stack
312     var indented-col/ebx: int <- copy left-col
313     indented-col <- add 1  # margin-right - 2 for padding spaces
314     # compute stack
315     var stack: value-stack
316     var stack-addr/edi: (addr value-stack) <- address stack
317     initialize-value-stack stack-addr, 0x10  # max-words
318     evaluate defs, bindings, scratch, final-word, stack-addr
319     # render stack
320     var curr-row/edx: int <- copy top-row
321     curr-row <- add 3  # stack-margin-top
322     var _max-width/eax: int <- value-stack-max-width stack-addr
323     var max-width/esi: int <- copy _max-width
324     var i/eax: int <- value-stack-length stack-addr
325     {
326       compare i, 0
327       break-if-<=
328       move-cursor screen, curr-row, indented-col
329       {
330         var val/eax: int <- pop-int-from-value-stack stack-addr
331         render-integer screen, val, max-width
332         var size/eax: int <- decimal-size val
333         compare size, max-width
334         break-if-<=
335         max-width <- copy size
336       }
337       curr-row <- increment
338       i <- decrement
339       loop
340     }
341   }
342 
343   # render word, initialize result
344   reset-formatting screen
345   move-cursor screen, top-row, left-col
346   print-word screen, final-word
347   {
348     var size/eax: int <- word-length final-word
349     compare size, max-width
350     break-if-<=
351     max-width <- copy size
352   }
353 
354   # update cursor
355   {
356     var f/eax: (addr word) <- copy final-word
357     compare f, cursor-word
358     break-if-!=
359     var cursor-index/eax: int <- cursor-index cursor-word
360     cursor-index <- add left-col
361     var dest/edi: (addr int) <- copy cursor-col-a
362     copy-to *dest, cursor-index
363   }
364 
365   # post-process right-col
366   right-col <- copy max-width
367   right-col <- add left-col
368   right-col <- add 3  # margin-right
369 }
370 
371 # synaesthesia
372 fn render-integer screen: (addr screen), val: int, max-width: int {
373   var bg/eax: int <- hash-color val
374   var fg/ecx: int <- copy 7
375   {
376     compare bg, 2
377     break-if-!=
378     fg <- copy 0
379   }
380   {
381     compare bg, 3
382     break-if-!=
383     fg <- copy 0
384   }
385   {
386     compare bg, 6
387     break-if-!=
388     fg <- copy 0
389   }
390   start-color screen, fg, bg
391   print-grapheme screen, 0x20  # space
392   print-int32-decimal-right-justified screen, val, max-width
393   print-grapheme screen, 0x20  # space
394 }
395 
396 fn hash-color val: int -> result/eax: int {
397   result <- try-modulo val, 7  # assumes that 7 is always the background color
398 }
399 
400 fn clear-canvas _env: (addr environment) {
401   var env/esi: (addr environment) <- copy _env
402   var screen-ah/edi: (addr handle screen) <- get env, screen
403   var _screen/eax: (addr screen) <- lookup *screen-ah
404   var screen/edi: (addr screen) <- copy _screen
405   clear-screen screen
406   var nrows/eax: (addr int) <- get env, nrows
407   var _repl-col/ecx: (addr int) <- get env, code-separator-col
408   var repl-col/ecx: int <- copy *_repl-col
409   draw-vertical-line screen, 1, *nrows, repl-col
410   move-cursor screen, 3, 2
411   print-string screen, "x 2* = x 2 *"
412   move-cursor screen, 4, 2
413   print-string screen, "x 1+ = x 1 +"
414   move-cursor screen, 5, 2
415   print-string screen, "x 2+ = x 1+ 1+"
416 }
417 
418 fn real-grapheme? g: grapheme -> result/eax: boolean {
419 $real-grapheme?:body: {
420   # if g == newline return true
421   compare g, 0xa
422   {
423     break-if-!=
424     result <- copy 1  # true
425     break $real-grapheme?:body
426   }
427   # if g == tab return true
428   compare g, 9
429   {
430     break-if-!=
431     result <- copy 1  # true
432     break $real-grapheme?:body
433   }
434   # if g < 32 return false
435   compare g, 0x20
436   {
437     break-if->=
438     result <- copy 0  # false
439     break $real-grapheme?:body
440   }
441   # if g <= 255 return true
442   compare g, 0xff
443   {
444     break-if->
445     result <- copy 1  # true
446     break $real-grapheme?:body
447   }
448   # if (g&0xff == Esc) it's an escape sequence
449   and-with g, 0xff
450   compare g, 0x1b  # Esc
451   {
452     break-if-!=
453     result <- copy 0  # false
454     break $real-grapheme?:body
455   }
456   # otherwise return true
457   result <- copy 1  # true
458 }
459 }