From 7e013a1c9cfed3cc64faf423f3b9a7613a7f02eb Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 19 Jul 2021 06:55:31 -0700 Subject: op: consolidate testing for @rec/@(rec ...) * stdlib/op.tl (sys:op-rec-p): Test for both the variable @rec and the expresson @(rec ...). Also, the expr argument of the function is renamed to exp because it causes a problem, due to that symbol, sys:expr, being the meta indicator. (sys:op-ensure-rec): Remove one test for (sys:var usr:rec), since sys:op-rec-p does it. Convert one equal-test to a call to sys:op-rec-p. --- stdlib/op.tl | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/stdlib/op.tl b/stdlib/op.tl index 7dffa6ee..236d0c25 100644 --- a/stdlib/op.tl +++ b/stdlib/op.tl @@ -54,9 +54,10 @@ ((eq x 'sys:var) (or (integerp y) (eq y 'rest)))))))) -(defun sys:op-rec-p (expr) - (tree-case expr - ((x (y . r)) (and (eq x 'sys:expr) (eq y 'usr:rec))))) +(defun sys:op-rec-p (exp) + (or (tree-case exp + ((x (y . r)) (and (eq x 'sys:expr) (eq y 'usr:rec)))) + (equal exp '(sys:var usr:rec)))) (defun sys:op-ensure-rec (ctx : recvar) (when recvar @@ -70,8 +71,7 @@ (cond ((and (slot ctx 'up) (or (sys:op-meta-p arg) - (sys:op-rec-p arg) - (equal arg '(sys:var usr:rec)))) + (sys:op-rec-p arg))) (let ((up (slot ctx 'up))) (slotset up 'nested t) ^(,(slot up 'meta) (quote ,arg)))) @@ -84,7 +84,7 @@ (unless (integerp arg) (sys:setq arg 0)) (sys:ensure-op-arg ,ctx arg)) - ((equal f '(sys:var usr:rec)) + ((sys:op-rec-p f) (sys:op-ensure-rec ,ctx t)) (t f))) ,*(if do-nested-metas -- cgit v1.2.3