mirror of
https://github.com/dschmenk/PLASMA.git
synced 2025-01-07 15:31:49 +00:00
Continue optimizing eval_expr & friends
This commit is contained in:
David Schmenk
parent
b834f4dc05
commit
320bfbef81
Binary file not shown.
@ -778,7 +778,7 @@ def pair_args(argsyms, argbase)#0
|
||||
end
|
||||
|
||||
def apply_funargs(funarg, argvals)
|
||||
var funexpr, argbase
|
||||
var funexpr, argbase, funalist
|
||||
|
||||
funexpr = funarg=>cdr=>car // Lambda expression
|
||||
if funexpr->type <> CONS_TYPE
|
||||
@ -789,118 +789,118 @@ def apply_funargs(funarg, argvals)
|
||||
//
|
||||
push_sweep_stack(assoc_list) // Save current association list
|
||||
argbase = eval_args(argvals)
|
||||
assoc_list = funarg=>cdr=>cdr=>car // Swap association list pointer
|
||||
funalist = funarg=>cdr=>cdr
|
||||
assoc_list = funalist=>car // Swap association list pointer
|
||||
pair_args(funexpr=>cdr=>car, argbase)
|
||||
funexpr = eval_expr(funexpr=>cdr=>cdr=>car)
|
||||
funarg=>cdr=>cdr=>car = assoc_list // Save updated FUNARG associations
|
||||
assoc_list = pop_sweep_stack // Restore association list
|
||||
funexpr = eval_expr(funexpr=>cdr=>cdr=>car)
|
||||
funalist=>car = assoc_list // Save updated FUNARG associations
|
||||
assoc_list = pop_sweep_stack // Restore association list
|
||||
return funexpr
|
||||
end
|
||||
|
||||
export def eval_expr(expr)#1
|
||||
var alist_enter, curl, expr_car
|
||||
def eval_atom(atom)#1
|
||||
//
|
||||
// Atom - return the symbol value or the atom itself
|
||||
//
|
||||
if atom and atom->type & TYPE_MASK == SYM_TYPE
|
||||
if atom=>lambda // DEFINEd lambda S-expression
|
||||
return atom=>lambda
|
||||
fin
|
||||
if atom=>apval // Constant
|
||||
return atom=>apval ^ NULL_HACK
|
||||
fin
|
||||
if atom=>array // Array
|
||||
return atom=>array
|
||||
fin // Look on the association list last
|
||||
return assoc(atom)
|
||||
fin
|
||||
return atom
|
||||
end
|
||||
|
||||
if hook_eval; expr = hook_eval(expr); fin
|
||||
if gc_pull > GC_TRIGGER; gc; fin
|
||||
alist_enter = assoc_list
|
||||
curl = NULL // Current lambda
|
||||
while expr
|
||||
if expr->type == CONS_TYPE
|
||||
//
|
||||
// List - first element better be a function
|
||||
//
|
||||
expr_car = expr=>car
|
||||
if expr_car->type & TYPE_MASK == SYM_TYPE
|
||||
if expr_car=>natv
|
||||
expr = expr_car=>natv(expr_car, expr=>cdr) // Native function
|
||||
break
|
||||
elsif expr_car=>lambda // DEFINEd lambda S-expression
|
||||
expr_car = expr_car=>lambda
|
||||
elsif expr_car == sym_cond // Inline cond() evaluation
|
||||
expr = expr=>cdr
|
||||
while expr
|
||||
if eval_expr(expr=>car=>car)
|
||||
expr = expr=>car=>cdr=>car
|
||||
break
|
||||
export def eval_expr(expr)#1
|
||||
var alist_enter, curl, func, args
|
||||
|
||||
if expr
|
||||
if expr->type <> CONS_TYPE; return eval_atom(expr); fin
|
||||
if hook_eval; expr = hook_eval(expr); fin
|
||||
if gc_pull > GC_TRIGGER; gc; fin
|
||||
alist_enter = assoc_list
|
||||
curl = NULL // Current lambda
|
||||
while expr
|
||||
if expr->type == CONS_TYPE
|
||||
//
|
||||
// List - first element better be a function
|
||||
//
|
||||
func = expr=>car
|
||||
args = expr=>cdr
|
||||
if func->type & TYPE_MASK == SYM_TYPE
|
||||
if func=>natv
|
||||
expr = func=>natv(func, args) // Native function
|
||||
break
|
||||
elsif func == sym_cond // Inline cond() evaluation
|
||||
while args
|
||||
if eval_expr(args=>car=>car)
|
||||
expr = args=>car=>cdr=>car
|
||||
break
|
||||
fin
|
||||
args = args=>cdr
|
||||
loop
|
||||
elsif func == sym_if // Inline if() evaluation
|
||||
if eval_expr(args=>car)
|
||||
expr = args=>cdr=>car // THEN clause
|
||||
else
|
||||
expr = args=>cdr=>cdr
|
||||
if expr // Check for ELSE clause
|
||||
expr = expr=>car
|
||||
fin
|
||||
fin
|
||||
expr = expr=>cdr
|
||||
loop
|
||||
elsif expr_car == sym_if // Inline if() evaluation
|
||||
expr = expr=>cdr
|
||||
if eval_expr(expr=>car)
|
||||
expr = expr=>cdr=>car // THEN clause
|
||||
else
|
||||
expr = expr=>cdr=>cdr
|
||||
if expr // Check for ELSE clause
|
||||
expr = expr=>car
|
||||
else // Associated symbol
|
||||
func = eval_atom(func)
|
||||
if !func or func->type <> CONS_TYPE
|
||||
puts("Non-function EVAL:"); print_expr(expr); putln
|
||||
expr = NULL
|
||||
fin
|
||||
fin
|
||||
else // Associated symbol
|
||||
if expr_car=>apval
|
||||
expr_car = expr_car=>apval ^ NULL_HACK
|
||||
else
|
||||
expr_car = assoc(expr_car)
|
||||
if !expr_car // Make sure we don't hang
|
||||
puts("NULL EVAL:"); print_expr(expr); putln
|
||||
expr = NULL
|
||||
break
|
||||
else
|
||||
curl = NULL // Set-up for in-line LAMBDA
|
||||
fin
|
||||
if func->type == CONS_TYPE
|
||||
if func=>car == sym_label // LABEL
|
||||
new_assoc(func=>cdr=>car, func=>cdr=>cdr=>car) // Add LABEL
|
||||
func = func=>cdr=>cdr=>car // Continue evaluating LAMBDA
|
||||
fin
|
||||
if func=>car == sym_lambda // LAMBDA
|
||||
if curl == func // Tail recursion: overwrite associations
|
||||
set_args(func=>cdr=>car, eval_args(args))
|
||||
else // Add argument association pair list
|
||||
pair_args(func=>cdr=>car, eval_args(args))
|
||||
curl = func
|
||||
fin
|
||||
expr = func=>cdr=>cdr=>car
|
||||
if trace
|
||||
puts("\nTRACE:"); print_expr(func)
|
||||
puts("\n ASSOC:"); print_expr(assoc_list); putln
|
||||
fin
|
||||
elsif func=>car == sym_funarg // FUNARG
|
||||
expr = apply_funargs(func, expr=>cdr)
|
||||
break
|
||||
else
|
||||
puts("Non-LAMBDA EVAL:"); print_expr(expr); putln
|
||||
expr = NULL
|
||||
fin
|
||||
fin
|
||||
else
|
||||
curl = NULL // Set-up for in-line LAMBDA
|
||||
expr = eval_atom(expr)
|
||||
break
|
||||
fin
|
||||
if expr_car->type == CONS_TYPE
|
||||
if expr_car=>car == sym_label // LABEL
|
||||
new_assoc(expr_car=>cdr=>car, expr_car=>cdr=>cdr=>car) // Add LABEL
|
||||
expr_car = expr_car=>cdr=>cdr=>car // Continue evaluating LAMBDA
|
||||
fin
|
||||
if expr_car=>car == sym_lambda // LAMBDA
|
||||
if curl == expr_car // Tail recursion: overwrite associations
|
||||
set_args(expr_car=>cdr=>car, eval_args(expr=>cdr))
|
||||
else // Add argument association pair list
|
||||
pair_args(expr_car=>cdr=>car, eval_args(expr=>cdr))
|
||||
curl = expr_car
|
||||
fin
|
||||
expr = expr_car=>cdr=>cdr=>car
|
||||
if trace
|
||||
puts("\nTRACE:"); print_expr(expr_car)
|
||||
puts("\n ASSOC:"); print_expr(assoc_list); putln
|
||||
fin
|
||||
elsif expr_car=>car == sym_funarg // FUNARG
|
||||
expr = apply_funargs(expr_car, expr=>cdr)
|
||||
break
|
||||
else
|
||||
puts("Invalid EVAL:"); print_expr(expr); putln
|
||||
expr = NULL
|
||||
break
|
||||
fin
|
||||
fin
|
||||
else
|
||||
//
|
||||
// Atom - return the symbol value or the atom itself
|
||||
//
|
||||
if expr->type & TYPE_MASK == SYM_TYPE
|
||||
if expr=>apval // Constant
|
||||
expr = expr=>apval ^ NULL_HACK
|
||||
elsif expr=>lambda // DEFINEd lambda S-expression
|
||||
expr = expr=>lambda
|
||||
elsif expr=>array // Array
|
||||
expr = expr=>array
|
||||
else // Look on the association list last
|
||||
expr = assoc(expr)
|
||||
fin
|
||||
fin
|
||||
break
|
||||
fin
|
||||
loop
|
||||
assoc_list = alist_enter // Unwind assoc_list
|
||||
loop
|
||||
assoc_list = alist_enter // Unwind assoc_list
|
||||
fin
|
||||
return expr
|
||||
end
|
||||
|
||||
export def eval_quote(expr, hook)#1
|
||||
hook_eval = hook
|
||||
assoc_list = NULL
|
||||
push_sweep_stack(expr) // Keep expr from being GC'ed
|
||||
expr = eval_expr(expr)
|
||||
pop_sweep_stack
|
||||
|
||||
Loading…
Reference in New Issue
Block a user