diff --git a/src/lisp/fact.lisp b/src/lisp/fact.lisp index f15835d..2e206f3 100644 --- a/src/lisp/fact.lisp +++ b/src/lisp/fact.lisp @@ -1,8 +1,13 @@ -(label fact - (lambda (n) - (cond - ((eq n 0) , 1) - (t , (* n (fact (- n 1)))) - ) - ) +(define + (fact (lambda (n) + (cond ((eq n 0) , 1) + (t , (* n (fact (- n 1)))) + ) + )) ) + +(fact 1) +(fact 2) +(fact 3) +(fact 4) +(fact 5) diff --git a/src/lisp/gcd.lisp b/src/lisp/gcd.lisp index b1b29c6..39eb1a6 100644 --- a/src/lisp/gcd.lisp +++ b/src/lisp/gcd.lisp @@ -1,7 +1,8 @@ -(label gcd (lambda (x y) - (cond ((> x y) , (gcd y x)) - ((eq (rem y x) 0) , x) - (t , (gcd (rem y x) x)) - ) - ) +((label + gcd (lambda (x y) + (cond ((> x y) , (gcd y x)) + ((eq (rem y x) 0) , x) + (t , (gcd (rem y x) x)) + ) + )) 22 100 ) diff --git a/src/lisp/loop.lisp b/src/lisp/loop.lisp index 871ba76..2a0d6a2 100644 --- a/src/lisp/loop.lisp +++ b/src/lisp/loop.lisp @@ -22,13 +22,13 @@ )) ) -(PRINT 'TAIL) +'TAIL (TAILLOOP 1 100) -(PRINT 'WHILE) +'WHILE (WHILELOOP 1 100) -(PRINT 'UNTIL) +'UNTIL (UNTILLOOP 1 100) -(PRINT 'PROG) +'PROG (PROGLOOP 1 100) -(PRINT 'FOR) +'FOR (FORLOOP 1 100) diff --git a/src/lisp/prog.lisp b/src/lisp/prog.lisp index 3e18e62..c00f698 100644 --- a/src/lisp/prog.lisp +++ b/src/lisp/prog.lisp @@ -1,22 +1,21 @@ -(label lengthc (lambda (l) - (prog (u v) - (setq v 0) - (setq u l) - a (cond ((null u),(return v))) - (setq v (+ 1 v)) - (setq u (cdr u)) - (go a) - ) - ) -) - -(label lengthi (lambda (l) - (prog (u v) - (setq v 0) - (setq u l) - a (if (null u) (return v) (setq v (+ 1 v))) - (setq u (cdr u)) - (go a) - ) - ) +(define + (lengthc (lambda (l) + (prog (u v) + (setq v 0) + (setq u l) + a (cond ((null u),(return v))) + (setq v (+ 1 v)) + (setq u (cdr u)) + (go a) + ) + )) + (lengthi (lambda (l) + (prog (u v) + (setq v 0) + (setq u l) + a (if (null u) (return v) (setq v (+ 1 v))) + (setq u (cdr u)) + (go a) + ) + )) ) diff --git a/src/lisp/s-expr.pla b/src/lisp/s-expr.pla index b90288c..f4c929f 100644 --- a/src/lisp/s-expr.pla +++ b/src/lisp/s-expr.pla @@ -736,17 +736,17 @@ end def apply_args(curl, expr, argvals)#2 // curl, expr var argsyms, arglist, pairlist, argbase - if expr and expr->type <> CONS_TYPE - if expr->type & TYPE_MASK == SYM_TYPE - if expr=>natv - return curl, expr=>natv(expr, argvals) // Native function - elsif expr=>lambda // DEFINEd lambda S-expression - expr = expr=>lambda - else - expr = assoc(expr) - fin - fin - fin +// if expr and expr->type <> CONS_TYPE +// if expr->type & TYPE_MASK == SYM_TYPE +// if expr=>natv +// return curl, expr=>natv(expr, argvals) // Native function +// elsif expr=>lambda // DEFINEd lambda S-expression +// expr = expr=>lambda +// else +// expr = assoc(expr) +// fin +// fin +// fin if !expr or expr=>car <> sym_lambda puts("Invalid LAMBDA expression: "); print_expr(expr); putln return NULL, NULL @@ -902,14 +902,6 @@ export def eval_expr(expr)#1 expr = expr=>car fin fin - elsif expr_car == sym_label // LABEL - expr_car = expr=>cdr=>car - expr = expr=>cdr=>cdr=>car - if !set_assoc(expr_car, expr) - new_assoc(expr_car, expr) - alist_enter = assoc_list // Is this correct? - fin - break else // Associated symbol expr_car = assoc(expr_car) fin @@ -921,7 +913,11 @@ export def eval_expr(expr)#1 expr = eval_funarg(expr_car, expr=>cdr) break fin - if expr_car=>car == sym_lambda // FUNARG + 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 expression + fin + if expr_car=>car == sym_lambda // LAMBDA curl, expr = apply_args(curl, expr_car, expr=>cdr) fin fin diff --git a/src/lisp/s-math.pla b/src/lisp/s-math.pla index a90e4e4..a2e77b7 100644 --- a/src/lisp/s-math.pla +++ b/src/lisp/s-math.pla @@ -115,7 +115,7 @@ def push_num(numptr)#0 fin end -def natv_add(symptr, expr) +def natv_sum(symptr, expr) var num var[2] intsum var[5] extsum @@ -787,7 +787,8 @@ end // Install math functions // -new_sym("+")=>natv = @natv_add +new_sym("SUM")=>natv = @natv_sum +new_sym("+")=>natv = @natv_sum new_sym("-")=>natv = @natv_sub new_sym("*")=>natv = @natv_mul new_sym("/")=>natv = @natv_div diff --git a/src/lisp/set.lisp b/src/lisp/set.lisp index 6a7e701..f36c1e8 100644 --- a/src/lisp/set.lisp +++ b/src/lisp/set.lisp @@ -20,8 +20,8 @@ ) ) -(setq l1 '(a b c d e f)) -(setq l2 '(a c e g i k)) -(union l1 l2) -(intersection l1 l2) +'(union '(a b c d e f) '(a c e g i k)) +(union '(a b c d e f) '(a c e g i k)) +'(intersection '(a b c d e f) '(a c e g i k)) +(intersection '(a b c d e f) '(a c e g i k))