shell: starting to implement arrays

This commit is contained in:
Kartik K. Agaram 2021-07-25 14:40:05 -07:00
parent 492f7bd0b7
commit 170b6787c5
2 changed files with 65 additions and 5 deletions

View File

@ -22,10 +22,6 @@
args])
(ret . [mac (ret var val . body)
`(let ,var ,val ,@body ,var)])
(len . [def (len l)
if (no l)
0
(1 + (len (cdr l)))])
(nth . [def (nth n xs)
if (n < 1)
(car xs)

View File

@ -22,6 +22,7 @@ fn initialize-primitives _self: (addr global-table) {
append-primitive self, "no"
append-primitive self, "not"
append-primitive self, "dbg"
append-primitive self, "len"
# for pairs
append-primitive self, "car"
append-primitive self, "cdr"
@ -84,7 +85,7 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
draw-text-wrapping-right-then-down-from-cursor screen, "lists", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg
y <- increment
set-cursor-position screen, right-min, y
draw-text-wrapping-right-then-down-from-cursor screen, " cons car cdr no cons?", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
draw-text-wrapping-right-then-down-from-cursor screen, " cons car cdr no cons? len", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
y <- increment
set-cursor-position screen, right-min, y
draw-text-wrapping-right-then-down-from-cursor screen, "numbers", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg
@ -311,6 +312,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
apply-cons-check args-ah, out, trace
return
}
{
var len?/eax: boolean <- string-equal? f-name, "len"
compare len?, 0/false
break-if-=
apply-len args-ah, out, trace
return
}
{
var cell-isomorphic?/eax: boolean <- string-equal? f-name, "="
compare cell-isomorphic?, 0/false
@ -1184,6 +1192,62 @@ fn apply-cons-check _args-ah: (addr handle cell), out: (addr handle cell), trace
new-integer out, 1
}
fn apply-len _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
trace-text trace, "eval", "apply len"
var args-ah/eax: (addr handle cell) <- copy _args-ah
var _args/eax: (addr cell) <- lookup *args-ah
var args/esi: (addr cell) <- copy _args
{
var args-type/eax: (addr int) <- get args, type
compare *args-type, 0/pair
break-if-=
error trace, "args to len are not a list"
return
}
var empty-args?/eax: boolean <- nil? args
compare empty-args?, 0/false
{
break-if-=
error trace, "len needs 1 arg but got 0"
return
}
# args->left
var first-ah/edx: (addr handle cell) <- get args, left
var first/eax: (addr cell) <- lookup *first-ah
{
{
var first-pair?/eax: boolean <- pair? first
compare first-pair?, 0/false
}
break-if-=
var result/eax: int <- list-length first
new-integer out, result
return
}
nil out
}
fn list-length in: (addr cell) -> _/eax: int {
var curr/ecx: (addr cell) <- copy in
var result/edi: int <- copy 0
{
var pair?/eax: boolean <- pair? curr
{
compare pair?, 0/false
break-if-!=
abort "len: ran into a non-cons"
}
var nil?/eax: boolean <- nil? curr
compare nil?, 0/false
break-if-!=
result <- increment
var next-ah/eax: (addr handle cell) <- get curr, right
var next/eax: (addr cell) <- lookup *next-ah
curr <- copy next
loop
}
return result
}
fn apply-cell-isomorphic _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
trace-text trace, "eval", "apply '='"