mirror of
https://github.com/dschmenk/PLASMA.git
synced 2024-09-07 12:54:31 +00:00
Fix LABEL once and for all
This commit is contained in:
parent
604497c8b8
commit
843d0a85e7
@ -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)
|
||||
|
@ -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
|
||||
)
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
)
|
||||
))
|
||||
)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user