diff options
| -rw-r--r-- | stdlib/op.tl | 46 |
1 files changed, 25 insertions, 21 deletions
diff --git a/stdlib/op.tl b/stdlib/op.tl index b443a2d2..bd5b7a2f 100644 --- a/stdlib/op.tl +++ b/stdlib/op.tl @@ -246,26 +246,27 @@ (t nil))) (defun sys:opip-expand (e opsym dosym clauses) - (tree-case clauses - (nil nil) - ((c . rest) - (if (atom c) - (cons c (sys:opip-expand e opsym dosym rest)) - (let ((sym (car c))) - (cond - ((memq sym '(dwim uref qref op do lop lop1 ldo ap ip ado ido ret aret)) - (cons c (sys:opip-expand e opsym dosym rest))) - ((sys:opip-single-let-p c) - (tree-bind (t sym) c - (sys:opip-expand e opsym dosym ^((let (,sym @1)) ,*rest)))) - ((sys:opip-let-p c) - (tree-bind (t . vars) c - ^((do let* ,vars - [(opip ,*(sys:opip-expand e opsym dosym rest)) @1])))) - (t (let ((opdo (if (or (special-operator-p (car c)) - (macro-form-p c e)) dosym opsym))) - (cons ^(,opdo ,*c) (sys:opip-expand e opsym dosym - rest)))))))))) + (let ((opsym-rest (if (eq 'lop opsym) 'lop1 opsym))) + (tree-case clauses + (nil nil) + ((c . rest) + (if (atom c) + (cons c (sys:opip-expand e opsym-rest dosym rest)) + (let ((sym (car c))) + (cond + ((memq sym '(dwim uref qref op do lop lop1 ldo ap ip ado ido ret aret)) + (cons c (sys:opip-expand e opsym-rest dosym rest))) + ((sys:opip-single-let-p c) + (tree-bind (t sym) c + (sys:opip-expand e opsym-rest dosym ^((let (,sym @1)) ,*rest)))) + ((sys:opip-let-p c) + (tree-bind (t . vars) c + ^((do let* ,vars + [(opip ,*(sys:opip-expand e opsym-rest dosym rest)) @1])))) + (t (let ((opdo (if (or (special-operator-p (car c)) + (macro-form-p c e)) dosym opsym))) + (cons ^(,opdo ,*c) (sys:opip-expand e opsym-rest dosym + rest))))))))))) (defmacro opip (:env e . clauses) ^[chain ,*(sys:opip-expand e 'op 'do clauses)]) @@ -276,6 +277,9 @@ (defmacro lopip (:env e . clauses) ^[chain ,*(sys:opip-expand e 'lop 'ldo clauses)]) +(defmacro sys:lopip1 (:env e . clauses) + ^[chain ,*(sys:opip-expand e 'lop1 'ldo clauses)]) + (defmacro loand (:env e . clauses) ^[chand ,*(sys:opip-expand e 'lop 'ldo clauses)]) @@ -289,7 +293,7 @@ ^(call (opip ,*opip-args) ,val)) (defmacro lflow (val . opip-args) - ^(call (lopip ,*opip-args) ,val)) + ^(call (lopip1 ,*opip-args) ,val)) (defmacro tap (. args) ^(prog1 @1 ,args)) |