From c29ab9bd82d1465c9a784b27939eb27d1c8c2da7 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Thu, 11 Jul 2024 15:17:05 -0700 Subject: [PATCH] Improved tail recursion and loop example --- doc/DRAWL.md | 4 +-- src/lisp/README.md | 2 +- src/lisp/drawl.pla | 5 +--- src/lisp/loop.lisp | 11 ++++++++ src/lisp/s-expr.pla | 68 ++++++++++++++++++++++++++------------------- src/mklisp | 1 + src/mkrel | 1 + 7 files changed, 57 insertions(+), 35 deletions(-) create mode 100644 src/lisp/loop.lisp diff --git a/doc/DRAWL.md b/doc/DRAWL.md index be53c00..6a9cf9d 100644 --- a/doc/DRAWL.md +++ b/doc/DRAWL.md @@ -6,7 +6,7 @@ LISP interpreted on a bytecode VM running on a 1 MHz 6502 is going to be sssllll - The PROG feature isn't present. Programming is limited to interpreting lambda S-expressions - Number values are limited to 32 bit integers, no floating point -- Deep recursion. The 6502 architecture limits recursion, so don't expect too much here +- General recursion. The 6502 architecture limits recursion (but see tail recursion below), so don't expect too much here - Arrays not implemented However, the code is partitioned to allow for easy extension so some of these missing features could be implemented. @@ -14,7 +14,7 @@ However, the code is partitioned to allow for easy extension so some of these mi ## Features of DRAWL - 32 bit integers and basic math operators. Hey, better than you probably expected -- Recursion handles about nine levels deep. Better than nothing +- Tail recursion handles handles deep recursion. Check out [loop.lisp](https://github.com/dschmenk/PLASMA/blob/master/src/lisp/loop.lisp) - Fully garbage collected behind the scenes - Optionally read LISP source file at startup - SET and SETQ implemented for setting variables diff --git a/src/lisp/README.md b/src/lisp/README.md index 91cf8d3..c4956c8 100644 --- a/src/lisp/README.md +++ b/src/lisp/README.md @@ -6,6 +6,6 @@ s-expr.pla is the guts of the system. Some features missing from the LISP 1.5 ma drawl.pla because this is a sslloowwww implementation of LISP, so named DRAWL in keeping with the speech theme. The file reading and REPL functions are contained here. DRAWL is meant to be extensible so adding PROG and floating point is easily possible. -The sample LISP code comes from the LISP 1.5 manual. These are the only LISP programs that have been run on DRAWL, so other LISP programs may uncover bugs or limitations of DRAWL. +The sample LISP code comes from the LISP 1.5 manual. These are the only LISP programs that have been run on DRAWL, so other LISP programs may uncover bugs or limitations of DRAWL. HOwever, tail recursion is supported - check out loop.lisp More information and links can be found here: https://github.com/dschmenk/PLASMA/blob/master/doc/DRAWL.md diff --git a/src/lisp/drawl.pla b/src/lisp/drawl.pla index c8bdd80..afe4ae8 100644 --- a/src/lisp/drawl.pla +++ b/src/lisp/drawl.pla @@ -52,9 +52,6 @@ end // REPL interface to S-expression evaluator // -const GC_RESET = 2 -byte gc_trigger = GC_RESET - const FILEBUF_SIZE = 128 var readfn // read input routine var fileref, filebuf // file read vars @@ -165,7 +162,7 @@ new_sym("BYE")=>natv = @natv_bye new_sym("MEM")=>natv = @natv_memavail while not quit putln; print_expr(eval_expr(readfn())) - gc_trigger--; if gc_trigger == 0; gc; gc_trigger = GC_RESET; fin + gc loop putln done diff --git a/src/lisp/loop.lisp b/src/lisp/loop.lisp new file mode 100644 index 0000000..dba0e6f --- /dev/null +++ b/src/lisp/loop.lisp @@ -0,0 +1,11 @@ +(LABEL LOOP (LAMBDA (I M FN) + (COND ((AND (< I M) (FN I)),(LOOP (+ 1 I) M FN)) + (T,(EQ I M))) + ) +) +(LABEL LPRINT (LAMBDA (N) + (ATOM (PRINT N)) + ) +) + +(LOOP 1 100 LPRINT) diff --git a/src/lisp/s-expr.pla b/src/lisp/s-expr.pla index ee54eb5..c264993 100644 --- a/src/lisp/s-expr.pla +++ b/src/lisp/s-expr.pla @@ -476,44 +476,56 @@ end // Evaluate expression // -def enter_lambda(expr, params) +def enter_lambda(curl, expr, params)#2 // curl, expr var args, arglist, pairlist, pair if !expr or expr=>car <> sym_lambda puts("Invalid LAMBDA expression: ") print_expr(expr) - return NULL + return NULL, NULL fin - // - // Build arg list before prepending to assoc_list - // - args = expr=>cdr=>car - arglist = NULL - while args + args = expr=>cdr=>car + if curl == expr + // + // Update current associations during tail recursion + // + while args + assoc(args=>car)=>cdr = eval_expr(params=>car) + args = args=>cdr + params = params=>cdr + loop + else + // + // Build arg list before prepending to assoc_list + // + arglist = NULL + while args + if arglist + pairlist=>cdr = new_cons + pairlist = pairlist=>cdr + else + arglist = new_cons + pairlist = arglist + fin + pair = new_cons + pair=>car = args=>car + pair=>cdr = eval_expr(params=>car) + pairlist=>car = pair + args = args=>cdr + params = params=>cdr + loop if arglist - pairlist=>cdr = new_cons - pairlist = pairlist=>cdr - else - arglist = new_cons - pairlist = arglist + pairlist=>cdr = assoc_list + assoc_list = arglist fin - pair = new_cons - pair=>car = args=>car - pair=>cdr = eval_expr(params=>car) - pairlist=>car = pair - args = args=>cdr - params = params=>cdr - loop - if arglist - pairlist=>cdr = assoc_list - assoc_list = arglist fin - return expr=>cdr=>cdr=>car + return expr, expr=>cdr=>cdr=>car end export def eval_expr(expr)#1 - var alist_enter, expr_car + var alist_enter, curl, expr_car + curl = NULL // Current lambda alist_enter = assoc_list while expr if expr->type == CONS_TYPE @@ -526,7 +538,7 @@ export def eval_expr(expr)#1 expr = expr_car=>natv(expr=>cdr) // Native function break elsif expr_car=>lambda // DEFINEd lambda S-expression - expr = enter_lambda(expr_car=>lambda, expr=>cdr) + curl, expr = enter_lambda(curl, expr_car=>lambda, expr=>cdr) elsif expr_car == sym_cond // Inline cond() evaluation expr = expr=>cdr while expr @@ -537,10 +549,10 @@ export def eval_expr(expr)#1 expr = expr=>cdr loop else // Symbol associated with lambda - expr = enter_lambda(assoc(expr_car)=>cdr, expr=>cdr) + curl, expr = enter_lambda(curl, assoc(expr_car)=>cdr, expr=>cdr) fin elsif expr_car->type == CONS_TYPE and expr_car=>car == sym_lambda - expr = enter_lambda(expr_car, expr=>cdr) // Inline lambda + curl, expr = enter_lambda(NULL, expr_car, expr=>cdr) // Inline lambda fin else // diff --git a/src/mklisp b/src/mklisp index 30a573e..17e07d0 100755 --- a/src/mklisp +++ b/src/mklisp @@ -23,3 +23,4 @@ cat lisp/list.lisp | ./ac.jar -ptx DRAWL.po lisp/LIST.LISP TXT cat lisp/maplist.lisp | ./ac.jar -ptx DRAWL.po lisp/MAPLIST.LISP TXT cat lisp/gcd.lisp | ./ac.jar -ptx DRAWL.po lisp/GCD.LISP TXT cat lisp/fact.lisp | ./ac.jar -ptx DRAWL.po lisp/FACT.LISP TXT +cat lisp/loop.lisp | ./ac.jar -ptx DRAWL.po lisp/LOOP.LISP TXT diff --git a/src/mkrel b/src/mkrel index b04a9a0..1d0c072 100755 --- a/src/mkrel +++ b/src/mkrel @@ -183,6 +183,7 @@ cp lisp/list.lisp prodos/bld/lisp/LIST.LISP.TXT cp lisp/maplist.lisp prodos/bld/lisp/MAPLIST.LISP.TXT cp lisp/gcd.lisp prodos/bld/lisp/GCD.LISP.TXT cp lisp/fact.lisp prodos/bld/lisp/FACT.LISP.TXT +cp lisp/loop.lisp prodos/bld/lisp/LOOP.LISP.TXT #mkdir prodos/bld/examples #cp samplesrc/examples/ex.1.pla prodos/bld/examples/EX.1.PLA.TXT