mirror of
https://github.com/dschmenk/PLASMA.git
synced 2024-09-07 12:54:31 +00:00
Fix looping ops to use variables instead of constants (LISP 1.5 uses constants)
This commit is contained in:
parent
01a5f0d75b
commit
7ee1c2f524
@ -18,6 +18,8 @@ However, the code is partitioned to allow for easy extension so some of these mi
|
||||
- Arrays of up to four dimensions
|
||||
- FUNCTION operation with bound variables
|
||||
- Additional testing/looping construct: IF, FOR, WHILE, UNTIL
|
||||
- Bit-wise logic operations on 32 bit integers
|
||||
- Hexadecimal input/output
|
||||
|
||||
LISP is one of the earliest computer languages. As such, it holds a special place in the anals of computer science. I've always wanted to learn why LISP is held in such high regard by so many, so I went about learning LISP by actually implementing a LISP interpreter in PLASMA. PLASMA is well suited to implement other languages due to its rich syntax, performance and libraries.
|
||||
|
||||
|
@ -116,13 +116,13 @@ def natv_prog(symptr, expr)
|
||||
fin
|
||||
loop
|
||||
prog = prog_enter
|
||||
expr = eval_expr(prog_return)
|
||||
expr = prog_return
|
||||
prog_return = FALSE
|
||||
return expr
|
||||
end
|
||||
|
||||
def natv_return(symptr, expr)
|
||||
prog_return = expr=>car
|
||||
prog_return = eval_expr(expr=>car)
|
||||
return NULL // This value will be dropped in natv_prog
|
||||
end
|
||||
|
||||
|
@ -1,20 +1,34 @@
|
||||
(DEFINE
|
||||
(LOOP (LAMBDA (I M FN)
|
||||
(COND ((AND (< I M) (FN I)),(LOOP (+ 1 I) M FN))
|
||||
(TAILLOOP (LAMBDA (I M)
|
||||
(COND ((AND (< I M) (PRI I)),(TAILLOOP (+ 1 I) M))
|
||||
(T,(EQ I M)))
|
||||
))
|
||||
(LPRINT (LAMBDA (N)
|
||||
(PRINT N)
|
||||
(WHILELOOP (LAMBDA (I M)
|
||||
(WHILE (< I M) (PRI I) (SETQ I (+ I 1)))
|
||||
))
|
||||
(UNTILLOOP (LAMBDA (I M)
|
||||
(UNTIL (> I M) (PRI I) (SETQ I (+ I 1)))
|
||||
))
|
||||
(PROGLOOP (LAMBDA (I M)
|
||||
(PROG (X)
|
||||
(SETQ X (- M 1))
|
||||
A (PRI I)
|
||||
(SETQ I (+ I 1))
|
||||
(IF (< I X) (GO A))
|
||||
(RETURN I)
|
||||
)))
|
||||
(FORLOOP (LAMBDA (I M)
|
||||
(FOR I 1 1 (< I M) (PRI I))
|
||||
))
|
||||
)
|
||||
|
||||
(PRINTLN 'TAIL)
|
||||
(LOOP 1 100 LPRINT)
|
||||
(PRINT 'FOR)
|
||||
(FOR I 1 1 (< I 100) (PRINT I))
|
||||
(PRINT 'TAIL)
|
||||
(TAILLOOP 1 100)
|
||||
(PRINT 'WHILE)
|
||||
(CSETQ I 0)
|
||||
(WHILE (< I 100) (PRINT I) (CSETQ I (+ I 1)))
|
||||
(WHILELOOP 1 100)
|
||||
(PRINT 'UNTIL)
|
||||
(CSETQ I 1)
|
||||
(UNTIL (> I 99) (PRINT I) (CSETQ I (+ I 1)))
|
||||
(UNTILLOOP 1 100)
|
||||
(PRINT 'PROG)
|
||||
(PROGLOOP 1 100)
|
||||
(PRINT 'FOR)
|
||||
(FORLOOP 1 100)
|
||||
|
@ -50,6 +50,8 @@ struc t_array
|
||||
word arraymem
|
||||
end
|
||||
|
||||
byte trace = FALSE
|
||||
|
||||
const fmt_fp = FPSTR_FIXED|FPSTR_STRIP|FPSTR_FLEX
|
||||
export var fmt_fpint = 6
|
||||
export var fmt_fpfrac = 4
|
||||
@ -744,6 +746,9 @@ def apply_args(curl, expr, argvals)#2 // curl, expr
|
||||
argsyms = argsyms=>cdr
|
||||
argbase++
|
||||
loop
|
||||
if trace
|
||||
puts("TAIL call:")
|
||||
fin
|
||||
else
|
||||
//
|
||||
// Build arg list before prepending to assoc_list
|
||||
@ -770,6 +775,15 @@ def apply_args(curl, expr, argvals)#2 // curl, expr
|
||||
pairlist=>cdr = assoc_list
|
||||
assoc_list = arglist
|
||||
fin
|
||||
if trace
|
||||
puts("APPLY call:")
|
||||
fin
|
||||
fin
|
||||
if trace
|
||||
print_expr(expr)
|
||||
putln
|
||||
print_expr(assoc_list)
|
||||
putln
|
||||
fin
|
||||
return expr, expr=>cdr=>cdr=>car
|
||||
end
|
||||
@ -824,6 +838,13 @@ def eval_funarg(funarg, argvals)
|
||||
funexpr = eval_expr(funexpr=>cdr=>cdr=>car)
|
||||
funarg=>cdr=>cdr=>car = assoc_list // Save current environ
|
||||
assoc_list = pop_sweep_stack
|
||||
if trace
|
||||
puts("FUNARG call:")
|
||||
print_expr(funarg)
|
||||
putln
|
||||
print_expr(assoc_list)
|
||||
putln
|
||||
fin
|
||||
return funexpr
|
||||
end
|
||||
|
||||
@ -832,6 +853,9 @@ export def eval_expr(expr)#1
|
||||
|
||||
if gc_pull > GC_TRIGGER; gc; fin
|
||||
curl = NULL // Current lambda
|
||||
if trace
|
||||
puts("EVAL: "); print_expr(expr); putln
|
||||
fin
|
||||
while expr
|
||||
if expr->type == CONS_TYPE
|
||||
//
|
||||
@ -875,6 +899,8 @@ export def eval_expr(expr)#1
|
||||
puts("Unknown function:"); print_expr(expr); putln
|
||||
expr = NULL
|
||||
fin
|
||||
else
|
||||
expr = expr_car
|
||||
fin
|
||||
fin
|
||||
elsif expr_car->type == CONS_TYPE and expr_car=>car == sym_lambda
|
||||
@ -898,6 +924,9 @@ export def eval_expr(expr)#1
|
||||
break
|
||||
fin
|
||||
loop
|
||||
if trace
|
||||
puts("RESULT: "); print_expr(expr); putln
|
||||
fin
|
||||
return expr
|
||||
end
|
||||
|
||||
@ -1212,7 +1241,7 @@ end
|
||||
|
||||
def natv_prhex(symptr, expr)
|
||||
if expr
|
||||
prhex = eval_expr(expr=>car)
|
||||
prhex = eval_expr(expr=>car) ?? TRUE :: FALSE
|
||||
fin
|
||||
return bool_pred(prhex)
|
||||
end
|
||||
@ -1225,7 +1254,7 @@ end
|
||||
|
||||
def natv_for(symptr, expr)
|
||||
var index, ufunc, dlist
|
||||
var[2] incval, stepval
|
||||
var[2] indexval, incval, stepval
|
||||
|
||||
index = expr=>car
|
||||
expr = expr=>cdr
|
||||
@ -1233,6 +1262,13 @@ def natv_for(symptr, expr)
|
||||
puts("For index not symbol\n")
|
||||
return NULL
|
||||
fin
|
||||
symptr = eval_expr(index)
|
||||
if symptr->type <> NUM_INT
|
||||
puts("FOR index not integer\n")
|
||||
return NULL
|
||||
fin
|
||||
indexval[0] = symptr=>intval[0]
|
||||
indexval[1] = symptr=>intval[1]
|
||||
symptr = eval_expr(expr=>car)
|
||||
expr = expr=>cdr
|
||||
if symptr->type <> NUM_INT
|
||||
@ -1241,7 +1277,6 @@ def natv_for(symptr, expr)
|
||||
fin
|
||||
incval[0] = symptr=>intval[0]
|
||||
incval[1] = symptr=>intval[1]
|
||||
index=>apval = symptr ^ NULL_HACK
|
||||
symptr = eval_expr(expr=>car)
|
||||
expr = expr=>cdr
|
||||
if symptr->type <> NUM_INT
|
||||
@ -1265,9 +1300,10 @@ def natv_for(symptr, expr)
|
||||
sweep_stack[sweep_stack_top - 1] = eval_expr(expr=>car)
|
||||
expr = expr=>cdr
|
||||
loop
|
||||
load32((index=>apval ^ NULL_HACK) + intval)
|
||||
load32(@indexval)
|
||||
add32(@stepval)
|
||||
store32((index=>apval ^ NULL_HACK) + intval)
|
||||
store32(@indexval)
|
||||
set_assoc(index, new_int(indexval[0], indexval[1]))
|
||||
loop
|
||||
return pop_sweep_stack
|
||||
end
|
||||
@ -1316,6 +1352,14 @@ def natv_until(symptr, expr)
|
||||
return pop_sweep_stack
|
||||
end
|
||||
|
||||
def natv_trace(symptr, expr)
|
||||
if expr
|
||||
trace = eval_expr(expr=>car) ?? TRUE :: FALSE
|
||||
fin
|
||||
return bool_pred(prhex)
|
||||
end
|
||||
|
||||
|
||||
//
|
||||
// Install default functions
|
||||
//
|
||||
@ -1357,5 +1401,6 @@ new_sym("PRINT")=>natv = @natv_print
|
||||
new_sym("FOR")=>natv = @natv_for
|
||||
new_sym("WHILE")=>natv = @natv_while
|
||||
new_sym("UNTIL")=>natv = @natv_until
|
||||
new_sym("TRACE")=>natv = @natv_trace
|
||||
return modkeep | modinitkeep
|
||||
done
|
||||
|
Loading…
Reference in New Issue
Block a user