diff options
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/doc-syms.tl | 9 | ||||
-rw-r--r-- | stdlib/op.tl | 28 |
2 files changed, 25 insertions, 12 deletions
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 79a52f39..be86e9d7 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -806,7 +806,7 @@ ("floor" "D-0082") ("floor-rem" "N-02DE978F") ("floor1" "N-01ED20D1") - ("flow" "N-02B2153E") + ("flow" "N-0178C76B") ("flush" "N-02390935") ("flush-stream" "N-03999913") ("flusho" "N-0072FF5E") @@ -1157,6 +1157,7 @@ ("lexical-macro-p" "N-021EC6D2") ("lexical-symacro-p" "N-021EC6D2") ("lexical-var-p" "N-021EC6D2") + ("lflow" "N-0178C76B") ("lgamma" "D-0086") ("lib-version" "N-032F57D4") ("line" "N-02D5D09D") @@ -1176,6 +1177,7 @@ ("load-args-recurse" "N-03067356") ("load-for" "N-0020A085") ("load-time" "D-0089") + ("loand" "N-02C35B52") ("loff-t" "N-01153D9E") ("log" "D-005A") ("log-alert" "N-035D75EC") @@ -1212,6 +1214,7 @@ ("long-suffix" "N-00A3183A") ("longlong" "N-02299408") ("lop" "N-017F3A22") + ("lopip" "N-02C35B52") ("lset" "N-008216EC") ("lstat" "N-006DE1CC") ("lutimes" "N-00E96FCF") @@ -1410,7 +1413,7 @@ ("o-sync" "N-034BF6C9") ("o-trunc" "N-034BF6C9") ("o-wronly" "N-034BF6C9") - ("oand" "N-01937C5A") + ("oand" "N-02C35B52") ("obtain" "N-01556613") ("obtain*" "N-0102F0EB") ("obtain*-block" "N-0102F0EB") @@ -1440,7 +1443,7 @@ ("open-tail" "N-0348F89A") ("opendir" "N-024AA6F4") ("openlog" "N-037AA654") - ("opip" "N-01937C5A") + ("opip" "N-02C35B52") ("opost" "N-03BD477F") ("opt" "N-0047F5AB") ("opt-desc" "N-03FC5092") diff --git a/stdlib/op.tl b/stdlib/op.tl index 2a41fc5a..4b5b0311 100644 --- a/stdlib/op.tl +++ b/stdlib/op.tl @@ -231,32 +231,42 @@ (listp rest))) (t nil))) -(defun sys:opip-expand (e clauses) +(defun sys:opip-expand (e opsym dosym clauses) (tree-case clauses (nil nil) ((c . rest) (if (atom c) - (cons c (sys:opip-expand e rest)) + (cons c (sys:opip-expand e opsym dosym 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))) + (cons c (sys:opip-expand e opsym dosym rest))) ((sys:opip-single-let-p c) (tree-bind (t sym) c - (sys:opip-expand e ^((let (,sym @1)) ,*rest)))) + (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 rest)) @1])))) + [(opip ,*(sys:opip-expand e opsym dosym 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)))))))))) + (macro-form-p c e)) dosym opsym))) + (cons ^(,opdo ,*c) (sys:opip-expand e opsym dosym + rest)))))))))) (defmacro opip (:env e . clauses) - ^[chain ,*(sys:opip-expand e clauses)]) + ^[chain ,*(sys:opip-expand e 'op 'do clauses)]) (defmacro oand (:env e . clauses) - ^[chand ,*(sys:opip-expand e clauses)]) + ^[chand ,*(sys:opip-expand e 'op 'do clauses)]) + +(defmacro lopip (:env e . clauses) + ^[chain ,*(sys:opip-expand e 'lop 'ldo clauses)]) + +(defmacro loand (:env e . clauses) + ^[chand ,*(sys:opip-expand e 'lop 'ldo clauses)]) (defmacro flow (val . opip-args) ^(call (opip ,*opip-args) ,val)) + +(defmacro lflow (val . opip-args) + ^(call (lopip ,*opip-args) ,val)) |