7837 - printing s-expressions
This commit is contained in:
parent
0517cfd573
commit
0749772be1
|
@ -28,3 +28,9 @@ fn new-number _out: (addr handle cell) {
|
|||
var type/ecx: (addr int) <- get out-addr, type
|
||||
copy-to *type, 1/number
|
||||
}
|
||||
|
||||
fn new-pair _out: (addr handle cell) {
|
||||
var out/eax: (addr handle cell) <- copy _out
|
||||
allocate out
|
||||
# new cells have type pair by default
|
||||
}
|
||||
|
|
|
@ -1,13 +1,29 @@
|
|||
fn parse-input tokens: (addr stream cell), out: (addr handle cell), trace: (addr trace) {
|
||||
rewind-stream tokens
|
||||
parse-sexpression tokens, out, trace
|
||||
var empty?/eax: boolean <- stream-empty? tokens
|
||||
compare empty?, 0/false
|
||||
break-if-!=
|
||||
error trace, "unexpected tokens at end; only type in a single expression at a time"
|
||||
{
|
||||
break-if-=
|
||||
error trace, "nothing to parse"
|
||||
return
|
||||
}
|
||||
var close-paren?/eax: boolean <- parse-sexpression tokens, out, trace
|
||||
{
|
||||
compare close-paren?, 0/false
|
||||
break-if-=
|
||||
error trace, "')' is not a valid expression"
|
||||
return
|
||||
}
|
||||
{
|
||||
var empty?/eax: boolean <- stream-empty? tokens
|
||||
compare empty?, 0/false
|
||||
break-if-!=
|
||||
error trace, "unexpected tokens at end; only type in a single expression at a time"
|
||||
}
|
||||
}
|
||||
|
||||
fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) {
|
||||
# return value: true if close-paren was encountered
|
||||
fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) -> _/eax: boolean {
|
||||
trace-text trace, "read", "parse"
|
||||
trace-lower trace
|
||||
var curr-token-storage: cell
|
||||
|
@ -16,12 +32,60 @@ fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace
|
|||
compare empty?, 0/false
|
||||
{
|
||||
break-if-=
|
||||
error trace, "nothing to parse"
|
||||
return
|
||||
error trace, "end of stream; never found a balancing ')'"
|
||||
return 1/true
|
||||
}
|
||||
read-from-stream tokens, curr-token
|
||||
parse-atom curr-token, _out, trace
|
||||
$parse-sexpression:type-check: {
|
||||
# not bracket -> parse atom
|
||||
var is-bracket-token?/eax: boolean <- is-bracket-token? curr-token
|
||||
compare is-bracket-token?, 0/false
|
||||
{
|
||||
break-if-!=
|
||||
parse-atom curr-token, _out, trace
|
||||
break $parse-sexpression:type-check
|
||||
}
|
||||
# open paren -> parse list
|
||||
var is-open-paren?/eax: boolean <- is-open-paren-token? curr-token
|
||||
compare is-open-paren?, 0/false
|
||||
{
|
||||
break-if-=
|
||||
var curr/esi: (addr handle cell) <- copy _out
|
||||
$parse-sexpression:list-loop: {
|
||||
new-pair curr
|
||||
var curr-addr/eax: (addr cell) <- lookup *curr
|
||||
var left/ecx: (addr handle cell) <- get curr-addr, left
|
||||
{
|
||||
var is-close-paren?/eax: boolean <- parse-sexpression tokens, left, trace
|
||||
compare is-close-paren?, 0/false
|
||||
break-if-!= $parse-sexpression:list-loop
|
||||
}
|
||||
#
|
||||
curr <- get curr-addr, right
|
||||
loop
|
||||
}
|
||||
break $parse-sexpression:type-check
|
||||
}
|
||||
# close paren -> parse list
|
||||
var is-close-paren?/eax: boolean <- is-close-paren-token? curr-token
|
||||
compare is-close-paren?, 0/false
|
||||
{
|
||||
break-if-=
|
||||
trace-higher trace
|
||||
return 1/true
|
||||
}
|
||||
# otherwise abort
|
||||
var stream-storage: (stream byte 0x40)
|
||||
var stream/edx: (addr stream byte) <- address stream-storage
|
||||
write stream, "unexpected token "
|
||||
var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
|
||||
var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
|
||||
rewind-stream curr-token-data
|
||||
write-stream stream, curr-token-data
|
||||
trace trace, "error", stream
|
||||
}
|
||||
trace-higher trace
|
||||
return 0/false
|
||||
}
|
||||
|
||||
fn parse-atom _curr-token: (addr cell), _out: (addr handle cell), trace: (addr trace) {
|
||||
|
|
|
@ -1,50 +1,242 @@
|
|||
fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr trace) {
|
||||
clear-stream out
|
||||
trace-text trace, "print", "print-cell"
|
||||
trace-lower trace
|
||||
var in/eax: (addr handle cell) <- copy _in
|
||||
var in-addr/eax: (addr cell) <- lookup *in
|
||||
{
|
||||
var is-nil?/eax: boolean <- is-nil? in-addr
|
||||
compare is-nil?, 0/false
|
||||
break-if-=
|
||||
write out, "()"
|
||||
trace-higher trace
|
||||
return
|
||||
}
|
||||
var in-type/ecx: (addr int) <- get in-addr, type
|
||||
compare *in-type, 0/pair
|
||||
{
|
||||
break-if-!=
|
||||
print-list in-addr, out, trace
|
||||
trace-higher trace
|
||||
return
|
||||
}
|
||||
compare *in-type, 1/number
|
||||
{
|
||||
break-if-!=
|
||||
print-number in-addr, out, trace
|
||||
trace-higher trace
|
||||
return
|
||||
}
|
||||
compare *in-type, 2/symbol
|
||||
{
|
||||
break-if-!=
|
||||
print-symbol in-addr, out, trace
|
||||
trace-higher trace
|
||||
return
|
||||
}
|
||||
}
|
||||
|
||||
fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
|
||||
{
|
||||
compare trace, 0
|
||||
break-if-=
|
||||
#? trace-text trace, "print", "symbol"
|
||||
}
|
||||
trace-text trace, "print", "symbol"
|
||||
var in/esi: (addr cell) <- copy _in
|
||||
var data-ah/eax: (addr handle stream byte) <- get in, text-data
|
||||
var _data/eax: (addr stream byte) <- lookup *data-ah
|
||||
var data/esi: (addr stream byte) <- copy _data
|
||||
rewind-stream data
|
||||
{
|
||||
var done?/eax: boolean <- stream-empty? data
|
||||
compare done?, 0/false
|
||||
break-if-!=
|
||||
var g/eax: grapheme <- read-grapheme data
|
||||
write-grapheme out, g
|
||||
loop
|
||||
}
|
||||
write-stream out, data
|
||||
# trace
|
||||
rewind-stream data
|
||||
var stream-storage: (stream byte 0x40)
|
||||
var stream/ecx: (addr stream byte) <- address stream-storage
|
||||
write stream, "=> symbol "
|
||||
write-stream stream, data
|
||||
trace trace, "print", stream
|
||||
}
|
||||
|
||||
fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
|
||||
{
|
||||
compare trace, 0
|
||||
break-if-=
|
||||
#? trace-text trace, "print", "number"
|
||||
}
|
||||
var in/esi: (addr cell) <- copy _in
|
||||
var val/eax: (addr float) <- get in, number-data
|
||||
write-float-decimal-approximate out, *val, 3/precision
|
||||
# trace
|
||||
var stream-storage: (stream byte 0x40)
|
||||
var stream/ecx: (addr stream byte) <- address stream-storage
|
||||
write stream, "=> number "
|
||||
write-float-decimal-approximate stream, *val, 3/precision
|
||||
trace trace, "print", stream
|
||||
}
|
||||
|
||||
fn print-list _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
|
||||
var curr/esi: (addr cell) <- copy _in
|
||||
write out, "("
|
||||
$print-list:loop: {
|
||||
var left/ecx: (addr handle cell) <- get curr, left
|
||||
{
|
||||
var left-addr/eax: (addr cell) <- lookup *left
|
||||
var left-is-nil?/eax: boolean <- is-nil? left-addr
|
||||
compare left-is-nil?, 0/false
|
||||
{
|
||||
break-if-=
|
||||
trace-text trace, "print", "left is null"
|
||||
break $print-list:loop
|
||||
}
|
||||
}
|
||||
print-cell left, out, trace
|
||||
var right/ecx: (addr handle cell) <- get curr, right
|
||||
var right-addr/eax: (addr cell) <- lookup *right
|
||||
{
|
||||
compare right-addr, 0
|
||||
break-if-!=
|
||||
abort "null encountered"
|
||||
}
|
||||
{
|
||||
var right-is-nil?/eax: boolean <- is-nil? right-addr
|
||||
compare right-is-nil?, 0/false
|
||||
{
|
||||
break-if-=
|
||||
trace-text trace, "print", "right is null"
|
||||
break $print-list:loop
|
||||
}
|
||||
}
|
||||
write out, " "
|
||||
var right-type-addr/edx: (addr int) <- get right-addr, type
|
||||
{
|
||||
compare *right-type-addr, 0/pair
|
||||
break-if-=
|
||||
write out, ". "
|
||||
print-cell right, out, trace
|
||||
break $print-list:loop
|
||||
}
|
||||
curr <- copy right-addr
|
||||
loop
|
||||
}
|
||||
write out, ")"
|
||||
}
|
||||
|
||||
# Most lisps intern nil, but we don't really have globals yet, so we'll be
|
||||
# less efficient for now.
|
||||
fn is-nil? _in: (addr cell) -> _/eax: boolean {
|
||||
var in/esi: (addr cell) <- copy _in
|
||||
# if type != pair, return false
|
||||
var type/eax: (addr int) <- get in, type
|
||||
compare *type, 0/pair
|
||||
{
|
||||
break-if-=
|
||||
return 0/false
|
||||
}
|
||||
# if left != null, return false
|
||||
var left-ah/eax: (addr handle cell) <- get in, left
|
||||
var left/eax: (addr cell) <- lookup *left-ah
|
||||
compare left, 0
|
||||
{
|
||||
break-if-=
|
||||
return 0/false
|
||||
}
|
||||
# if right != null, return false
|
||||
var right-ah/eax: (addr handle cell) <- get in, right
|
||||
var right/eax: (addr cell) <- lookup *right-ah
|
||||
compare right, 0
|
||||
{
|
||||
break-if-=
|
||||
return 0/false
|
||||
}
|
||||
return 1/true
|
||||
}
|
||||
|
||||
fn test-print-cell-zero {
|
||||
var num-storage: (handle cell)
|
||||
var num/esi: (addr handle cell) <- address num-storage
|
||||
new-number num
|
||||
# value is 0 by default
|
||||
var out-storage: (stream byte 0x40)
|
||||
var out/edi: (addr stream byte) <- address out-storage
|
||||
print-cell num, out, 0/no-trace
|
||||
check-stream-equal out, "0", "F - test-print-cell-zero"
|
||||
}
|
||||
|
||||
fn test-print-cell-integer {
|
||||
var num-storage: (handle cell)
|
||||
var num/esi: (addr handle cell) <- address num-storage
|
||||
new-number num
|
||||
var num-addr/eax: (addr cell) <- lookup *num
|
||||
var num-data/eax: (addr float) <- get num-addr, number-data
|
||||
var src/xmm0: float <- rational 1, 1
|
||||
copy-to *num-data, src
|
||||
var out-storage: (stream byte 0x40)
|
||||
var out/edi: (addr stream byte) <- address out-storage
|
||||
print-cell num, out, 0/no-trace
|
||||
check-stream-equal out, "1", "F - test-print-cell-integer"
|
||||
}
|
||||
|
||||
fn test-print-cell-integer-2 {
|
||||
var num-storage: (handle cell)
|
||||
var num/esi: (addr handle cell) <- address num-storage
|
||||
new-number num
|
||||
var num-addr/eax: (addr cell) <- lookup *num
|
||||
var num-data/eax: (addr float) <- get num-addr, number-data
|
||||
var src/xmm0: float <- rational 0x30, 1
|
||||
copy-to *num-data, src
|
||||
var out-storage: (stream byte 0x40)
|
||||
var out/edi: (addr stream byte) <- address out-storage
|
||||
print-cell num, out, 0/no-trace
|
||||
check-stream-equal out, "48", "F - test-print-cell-integer-2"
|
||||
}
|
||||
|
||||
fn test-print-cell-fraction {
|
||||
var num-storage: (handle cell)
|
||||
var num/esi: (addr handle cell) <- address num-storage
|
||||
new-number num
|
||||
var num-addr/eax: (addr cell) <- lookup *num
|
||||
var num-data/eax: (addr float) <- get num-addr, number-data
|
||||
var src/xmm0: float <- rational 1, 2
|
||||
copy-to *num-data, src
|
||||
var out-storage: (stream byte 0x40)
|
||||
var out/edi: (addr stream byte) <- address out-storage
|
||||
print-cell num, out, 0/no-trace
|
||||
check-stream-equal out, "0.5", "F - test-print-cell-fraction"
|
||||
}
|
||||
|
||||
fn test-print-cell-symbol {
|
||||
var sym-storage: (handle cell)
|
||||
var sym/esi: (addr handle cell) <- address sym-storage
|
||||
new-symbol sym
|
||||
var sym-addr/eax: (addr cell) <- lookup *sym
|
||||
var sym-data-ah/eax: (addr handle stream byte) <- get sym-addr, text-data
|
||||
var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
|
||||
write sym-data, "abc"
|
||||
var out-storage: (stream byte 0x40)
|
||||
var out/edi: (addr stream byte) <- address out-storage
|
||||
print-cell sym, out, 0/no-trace
|
||||
check-stream-equal out, "abc", "F - test-print-cell-symbol"
|
||||
}
|
||||
|
||||
fn test-print-cell-nil-list {
|
||||
var nil-storage: (handle cell)
|
||||
var nil/esi: (addr handle cell) <- address nil-storage
|
||||
new-pair nil
|
||||
var out-storage: (stream byte 0x40)
|
||||
var out/edi: (addr stream byte) <- address out-storage
|
||||
print-cell nil, out, 0/no-trace
|
||||
check-stream-equal out, "()", "F - test-print-cell-nil-list"
|
||||
}
|
||||
|
||||
fn test-print-cell-singleton-list {
|
||||
var list-storage: (handle cell)
|
||||
var list/esi: (addr handle cell) <- address list-storage
|
||||
new-pair list
|
||||
# left
|
||||
var list-addr/eax: (addr cell) <- lookup *list
|
||||
var list-left/eax: (addr handle cell) <- get list-addr, left
|
||||
new-symbol list-left
|
||||
var sym-addr/eax: (addr cell) <- lookup *list-left
|
||||
var sym-data-ah/eax: (addr handle stream byte) <- get sym-addr, text-data
|
||||
var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
|
||||
write sym-data, "abc"
|
||||
# right
|
||||
var list-addr/eax: (addr cell) <- lookup *list
|
||||
var list-right/eax: (addr handle cell) <- get list-addr, right
|
||||
new-pair list-right
|
||||
#
|
||||
var out-storage: (stream byte 0x40)
|
||||
var out/edi: (addr stream byte) <- address out-storage
|
||||
print-cell list, out, 0/no-trace
|
||||
check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
|
||||
}
|
||||
|
|
|
@ -175,6 +175,7 @@ fn run in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
|
|||
return
|
||||
}
|
||||
# TODO: eval
|
||||
clear-stream out
|
||||
print-cell read-result, out, trace
|
||||
mark-lines-dirty trace
|
||||
}
|
||||
|
|
|
@ -382,3 +382,41 @@ fn is-number-token? _in: (addr cell) -> _/eax: boolean {
|
|||
var result/eax: boolean <- is-decimal-digit? g
|
||||
return result
|
||||
}
|
||||
|
||||
fn is-bracket-token? _in: (addr cell) -> _/eax: boolean {
|
||||
var in/eax: (addr cell) <- copy _in
|
||||
var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
|
||||
var in-data/eax: (addr stream byte) <- lookup *in-data-ah
|
||||
rewind-stream in-data
|
||||
var g/eax: grapheme <- read-grapheme in-data
|
||||
var result/eax: boolean <- is-bracket-grapheme? g
|
||||
return result
|
||||
}
|
||||
|
||||
fn is-open-paren-token? _in: (addr cell) -> _/eax: boolean {
|
||||
var in/eax: (addr cell) <- copy _in
|
||||
var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
|
||||
var in-data/eax: (addr stream byte) <- lookup *in-data-ah
|
||||
rewind-stream in-data
|
||||
var g/eax: grapheme <- read-grapheme in-data
|
||||
compare g, 0x28/open-paren
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
return 0/false
|
||||
}
|
||||
|
||||
fn is-close-paren-token? _in: (addr cell) -> _/eax: boolean {
|
||||
var in/eax: (addr cell) <- copy _in
|
||||
var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
|
||||
var in-data/eax: (addr stream byte) <- lookup *in-data-ah
|
||||
rewind-stream in-data
|
||||
var g/eax: grapheme <- read-grapheme in-data
|
||||
compare g, 0x29/open-paren
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
return 0/false
|
||||
}
|
||||
|
|
|
@ -30,6 +30,8 @@ type trace-line {
|
|||
|
||||
fn initialize-trace _self: (addr trace), capacity: int, visible-capacity: int {
|
||||
var self/esi: (addr trace) <- copy _self
|
||||
compare self, 0
|
||||
break-if-=
|
||||
var trace-ah/eax: (addr handle array trace-line) <- get self, data
|
||||
populate trace-ah, capacity
|
||||
var visible-ah/eax: (addr handle array trace-line) <- get self, visible
|
||||
|
@ -38,6 +40,8 @@ fn initialize-trace _self: (addr trace), capacity: int, visible-capacity: int {
|
|||
|
||||
fn clear-trace _self: (addr trace) {
|
||||
var self/eax: (addr trace) <- copy _self
|
||||
compare self, 0
|
||||
break-if-=
|
||||
var len/edx: (addr int) <- get self, first-free
|
||||
copy-to *len, 0
|
||||
# might leak memory; existing elements won't be used anymore
|
||||
|
@ -83,6 +87,8 @@ fn has-errors? _self: (addr trace) -> _/eax: boolean {
|
|||
|
||||
fn trace _self: (addr trace), label: (addr array byte), message: (addr stream byte) {
|
||||
var self/esi: (addr trace) <- copy _self
|
||||
compare self, 0
|
||||
break-if-=
|
||||
var data-ah/eax: (addr handle array trace-line) <- get self, data
|
||||
var data/eax: (addr array trace-line) <- lookup *data-ah
|
||||
var index-addr/edi: (addr int) <- get self, first-free
|
||||
|
@ -96,6 +102,8 @@ fn trace _self: (addr trace), label: (addr array byte), message: (addr stream by
|
|||
}
|
||||
|
||||
fn trace-text self: (addr trace), label: (addr array byte), s: (addr array byte) {
|
||||
compare self, 0
|
||||
break-if-=
|
||||
var data-storage: (stream byte 0x100)
|
||||
var data/eax: (addr stream byte) <- address data-storage
|
||||
write data, s
|
||||
|
@ -122,12 +130,16 @@ fn initialize-trace-line depth: int, label: (addr array byte), data: (addr strea
|
|||
|
||||
fn trace-lower _self: (addr trace) {
|
||||
var self/esi: (addr trace) <- copy _self
|
||||
compare self, 0
|
||||
break-if-=
|
||||
var depth/eax: (addr int) <- get self, curr-depth
|
||||
increment *depth
|
||||
}
|
||||
|
||||
fn trace-higher _self: (addr trace) {
|
||||
var self/esi: (addr trace) <- copy _self
|
||||
compare self, 0
|
||||
break-if-=
|
||||
var depth/eax: (addr int) <- get self, curr-depth
|
||||
decrement *depth
|
||||
}
|
||||
|
@ -136,6 +148,11 @@ fn render-trace screen: (addr screen), _self: (addr trace), xmin: int, ymin: int
|
|||
var already-hiding-lines?: boolean
|
||||
var y/ecx: int <- copy ymin
|
||||
var self/esi: (addr trace) <- copy _self
|
||||
compare self, 0
|
||||
{
|
||||
break-if-!=
|
||||
return ymin
|
||||
}
|
||||
clamp-cursor-to-top self, y
|
||||
var trace-ah/eax: (addr handle array trace-line) <- get self, data
|
||||
var _trace/eax: (addr array trace-line) <- lookup *trace-ah
|
||||
|
|
Loading…
Reference in New Issue