summaryrefslogtreecommitdiffstats
path: root/stdlib/op.tl
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/op.tl')
-rw-r--r--stdlib/op.tl43
1 files changed, 34 insertions, 9 deletions
diff --git a/stdlib/op.tl b/stdlib/op.tl
index 31d0dc37..2a41fc5a 100644
--- a/stdlib/op.tl
+++ b/stdlib/op.tl
@@ -216,16 +216,41 @@
(defmacro aret (arg)
^(ap identity* ,arg))
+(defun sys:opip-single-let-p (c)
+ (tree-case c
+ ((op sym)
+ (and (eq op 'let)
+ (atom sym)))
+ (t nil)))
+
+(defun sys:opip-let-p (c)
+ (tree-case c
+ ((op (sym t) . rest)
+ (and (eq op 'let)
+ (atom sym)
+ (listp rest)))
+ (t nil)))
+
(defun sys:opip-expand (e clauses)
- (collect-each ((c clauses))
- (if (atom c)
- c
- (let ((sym (car c)))
- (if (member sym '(dwim uref qref op do lop ldo ap ip ado ido ret aret))
- c
- (let ((opdo (if (or (special-operator-p (car c))
- (macro-form-p c e)) 'do 'op)))
- ^(,opdo ,*c)))))))
+ (tree-case clauses
+ (nil nil)
+ ((c . rest)
+ (if (atom c)
+ (cons c (sys:opip-expand e rest))
+ (let ((sym (car c)))
+ (cond
+ ((memq sym '(dwim uref qref op do lop ldo ap ip ado ido ret aret))
+ (cons c (sys:opip-expand e rest)))
+ ((sys:opip-single-let-p c)
+ (tree-bind (t sym) c
+ (sys:opip-expand e ^((let (,sym @1)) ,*rest))))
+ ((sys:opip-let-p c)
+ (tree-bind (t . vars) c
+ ^((do let* ,vars
+ [(opip ,*(sys:opip-expand e rest)) @1]))))
+ (t (let ((opdo (if (or (special-operator-p (car c))
+ (macro-form-p c e)) 'do 'op)))
+ (cons ^(,opdo ,*c) (sys:opip-expand e rest))))))))))
(defmacro opip (:env e . clauses)
^[chain ,*(sys:opip-expand e clauses)])