akkartik
/
mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

shell: primitive 'not'

This commit is contained in:
Kartik K. Agaram 2021-04-25 22:09:51 -07:00
parent 24a6f99107
commit bd9c1e6a79
1 changed files with 45 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
shell/global.mu
View File

@ -26,6 +26,8 @@ fn initialize-globals _self: (addr global-table) {
append-primitive self, ">="
# generic
append-primitive self, "="
append-primitive self, "no"
append-primitive self, "not"
# for pairs
append-primitive self, "car"
append-primitive self, "cdr"
@ -216,11 +218,9 @@ fn render-primitives screen: (addr screen), xmin: int, ymin: int, xmax: int, yma
tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
y <- increment
var tmpx/eax: int <- copy xmin
tmpx <- draw-text-rightward screen, "fn if while = set def ", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
tmpx <- draw-text-rightward screen, "numbers: ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
tmpx <- draw-text-rightward screen, "fn def set if while = no(t) car cdr cons ", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
tmpx <- draw-text-rightward screen, "num: ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
tmpx <- draw-text-rightward screen, "+ - * / sqrt abs sgn < > <= >= ", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
tmpx <- draw-text-rightward screen, "pairs: ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
tmpx <- draw-text-rightward screen, "car cdr cons", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
}
fn primitive-global? _x: (addr global) -> _/eax: boolean {
@ -526,6 +526,20 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
apply-structurally-equal args-ah, out, trace
return
}
{
var not?/eax: boolean <- string-equal? f-name, "no"
compare not?, 0/false
break-if-=
apply-not args-ah, out, trace
return
}
{
var not?/eax: boolean <- string-equal? f-name, "not"
compare not?, 0/false
break-if-=
apply-not args-ah, out, trace
return
}
{
var lesser?/eax: boolean <- string-equal? f-name, "<"
compare lesser?, 0/false
@ -1073,6 +1087,33 @@ fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell
new-integer out, 1/true
}
fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
trace-text trace, "eval", "apply not"
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
# TODO: check that args is a pair
var empty-args?/eax: boolean <- nil? args
compare empty-args?, 0/false
{
break-if-=
error trace, "not needs 1 args but got 0"
return
}
# args->left
var first-ah/eax: (addr handle cell) <- get args, left
var first/eax: (addr cell) <- lookup *first-ah
# not
var nil?/eax: boolean <- nil? first
compare nil?, 0/false
{
break-if-!=
nil out
return
}
new-integer out, 1
}
fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
trace-text trace, "eval", "apply '<'"
var args-ah/eax: (addr handle cell) <- copy _args-ah