6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-08-09 16:25:01 +00:00
Code Issues Projects Releases Wiki Activity

Clean up NIL handling

Browse Source
This commit is contained in:
David Schmenk
2024-07-14 08:36:27 -07:00
parent f0678795de
commit d8ec9f9709
1 changed files with 33 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
src/lisp/s-expr.pla
View File

@@ -15,7 +15,7 @@ const NUM_FLOAT = $32
const ARRAY_TYPE = $40 const ARRAY_TYPE = $40
const MARK_BIT = $80 const MARK_BIT = $80
const MARK_MASK = $7F const MARK_MASK = $7F
const APVAL_HACK = 1 // Hack so we can set APVAL to NULL const NULL_HACK = 1 // Hack so we can set elements to NULL
struc t_elem struc t_elem
word link word link
@@ -51,7 +51,7 @@ end
predef eval_expr(expr) predef eval_expr(expr)
var sym_quote, sym_lambda, sym_cond, sym_set var sym_nil, sym_quote, sym_lambda, sym_cond, sym_set
res[t_elem] pred_true = 0, 0, BOOL_TRUE res[t_elem] pred_true = 0, 0, BOOL_TRUE
var cons_list = NULL var cons_list = NULL
@@ -574,7 +574,7 @@ export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr
break break
is ')' is ')'
if not exprptr if not exprptr
exprptr = new_cons // NIL exprptr = sym_nil
fin fin
return evalptr + 1, exprptr return evalptr + 1, exprptr
is '(' is '('
@@ -736,7 +736,7 @@ export def eval_expr(expr)#1
// //
if expr->type & TYPE_MASK == SYM_TYPE if expr->type & TYPE_MASK == SYM_TYPE
if expr=>apval if expr=>apval
expr = expr=>apval ^ APVAL_HACK expr = expr=>apval ^ NULL_HACK
elsif expr=>array elsif expr=>array
expr = expr=>array expr = expr=>array
else else
@@ -764,18 +764,13 @@ def natv_atom(symptr, expr)
end end
def natv_null(symptr, expr) def natv_null(symptr, expr)
symptr = eval_expr(expr=>car) return bool_pred(!eval_expr(expr=>car))
return bool_pred(!symptr or !symptr->type)
end end
def natv_eq(symptr, expr) def natv_eq(symptr, expr)
return bool_pred(eval_expr(expr=>car) == eval_expr(expr=>cdr=>car)) return bool_pred(eval_expr(expr=>car) == eval_expr(expr=>cdr=>car))
end end
def natv_not(symptr, expr)
return bool_pred(eval_expr(expr=>car) == NULL)
end
def natv_and(symptr, expr) def natv_and(symptr, expr)
while (expr and eval_expr(expr=>car) == @pred_true) while (expr and eval_expr(expr=>car) == @pred_true)
expr = expr=>cdr expr = expr=>cdr
@@ -903,16 +898,31 @@ def natv_array(symptr, expr)
aptr=>car = symptr aptr=>car = symptr
expr = expr=>cdr expr = expr=>cdr
if expr if expr
aptr=>cdr = new_cons aptr=>cdr = new_cons
aptr = aptr=>cdr aptr = aptr=>cdr
fin fin
loop loop
return arraylist return arraylist
end end
def natv_cset(symptr, expr) def natv_cset(symptr, expr)
symptr = eval_expr(expr=>car)
if symptr->type & TYPE_MASK <> SYM_TYPE
puts("CSET: Not a SYM\n")
return NULL
fin
expr = eval_expr(expr=>cdr=>car)
symptr=>apval = expr ^ NULL_HACK
return symptr
end
def natv_csetq(symptr, expr)
if symptr->type & TYPE_MASK <> SYM_TYPE
puts("CSETQ: Not a SYM\n")
return NULL
fin
symptr = eval_expr(expr=>cdr=>car) symptr = eval_expr(expr=>cdr=>car)
expr=>car=>apval = symptr ^ APVAL_HACK expr=>car=>apval = symptr ^ NULL_HACK
return symptr return symptr
end end
@@ -927,13 +937,14 @@ end
// Install default functions // Install default functions
// //
new_sym("NIL")=>apval = NULL ^ APVAL_HACK new_sym("T")=>apval = @pred_true ^ NULL_HACK
new_sym("F")=>apval = NULL ^ APVAL_HACK new_sym("F")=>apval = NULL_HACK
new_sym("T")=>apval = @pred_true ^ APVAL_HACK sym_nil = new_sym("NIL")
sym_lambda = new_sym("LAMBDA") sym_nil=>apval = NULL_HACK
sym_quote = new_sym("QUOTE") sym_lambda = new_sym("LAMBDA")
sym_cond = new_sym("COND") sym_cond = new_sym("COND")
sym_set = new_sym("SET") sym_set = new_sym("SET")
sym_quote = new_sym("QUOTE")
sym_quote=>natv = @natv_quote sym_quote=>natv = @natv_quote
new_sym("CAR")=>natv = @natv_car new_sym("CAR")=>natv = @natv_car
new_sym("CDR")=>natv = @natv_cdr new_sym("CDR")=>natv = @natv_cdr
@@ -941,7 +952,8 @@ new_sym("CONS")=>natv = @natv_cons
new_sym("ATOM")=>natv = @natv_atom new_sym("ATOM")=>natv = @natv_atom
new_sym("EQ")=>natv = @natv_eq new_sym("EQ")=>natv = @natv_eq
new_sym("CSET")=>natv = @natv_cset new_sym("CSET")=>natv = @natv_cset
new_sym("NOT")=>natv = @natv_not new_sym("CSETQ")=>natv = @natv_csetq
new_sym("NOT")=>natv = @natv_null
new_sym("AND")=>natv = @natv_and new_sym("AND")=>natv = @natv_and
new_sym("OR")=>natv = @natv_or new_sym("OR")=>natv = @natv_or
new_sym("NULL")=>natv = @natv_null new_sym("NULL")=>natv = @natv_null