Fix LABEL once and for all

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)

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
 )

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)

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)
+     )
+   ))
 )

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

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

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))