summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--stdlib/op.tl46
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))