ENH make rankfold function accumulate "stuff" in parallel
This commit is contained in:
parent
fb3b8f997d
commit
edf2480b6f
|
@ -668,28 +668,39 @@ used for optimization."
|
||||||
(lambda (child-bs)
|
(lambda (child-bs)
|
||||||
(funcall stop-fun (plist-get child-bs :local)))))
|
(funcall stop-fun (plist-get child-bs :local)))))
|
||||||
|
|
||||||
;; [Status a] -> b -> (a -> a -> Status Bool) -> (a -> Bool) -> (a -> Status b)
|
;; [Status a] -> b -> (a -> a -> Status Bool) -> (a -> Bool) -> (a -> Maybe c)
|
||||||
;; -> Status b
|
;; -> (a -> [c] -> Status b) -> Status b
|
||||||
(defun org-x-dag-bs-rankfold-children (bss default rank-fun stop-fun trans-fun)
|
(defun org-x-dag-bs-rankfold-children (bss default rank-fun stop-fun acc-fun trans-fun)
|
||||||
(declare (indent 2))
|
(declare (indent 2))
|
||||||
(let ((err (either :left "Child error")))
|
(let ((err (either :left "Child error")))
|
||||||
(cl-labels
|
(cl-labels
|
||||||
((fold-rank
|
((cons-maybe
|
||||||
|
(x xs)
|
||||||
|
(if x (cons x xs) xs))
|
||||||
|
(fold-rank
|
||||||
(acc xs)
|
(acc xs)
|
||||||
(if (not xs) (either :right acc)
|
(if (not xs) (either :right acc)
|
||||||
(-let (((x . rest) xs))
|
(-let (((x . rest) xs))
|
||||||
(pcase x
|
(pcase x
|
||||||
(`(:right ,r)
|
(`(:right ,r)
|
||||||
(either>>= (funcall rank-fun acc r)
|
(-let (((cur as) acc))
|
||||||
(if (not it) (fold-rank acc rest)
|
(either>>= (funcall rank-fun cur r)
|
||||||
(if (funcall stop-fun r) x (fold-rank r rest)))))
|
(let ((as* (cons-maybe (funcall acc-fun it) as)))
|
||||||
|
(if (not it) (fold-rank `(,cur ,as*) rest)
|
||||||
|
(if (funcall stop-fun r)
|
||||||
|
(either :right `(,r ,as*))
|
||||||
|
(fold-rank `(,r ,as*) rest)))))))
|
||||||
(_ err))))))
|
(_ err))))))
|
||||||
(if (not bss) (either :right default)
|
(if (not bss) (either :right default)
|
||||||
(pcase (car bss)
|
(pcase (car bss)
|
||||||
(`(:right ,r)
|
(`(:right ,r)
|
||||||
(if (funcall stop-fun r) (funcall trans-fun r)
|
(if (funcall stop-fun r)
|
||||||
(either>>= (fold-rank r (cdr bss))
|
(->> (funcall acc-fun r)
|
||||||
(funcall trans-fun it))))
|
(list)
|
||||||
|
(funcall trans-fun r))
|
||||||
|
(either>>= (fold-rank (list r nil) (cdr bss))
|
||||||
|
(-let (((cur as) it))
|
||||||
|
(funcall trans-fun cur as)))))
|
||||||
(_ err))))))
|
(_ err))))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-rankfold-children (bss default rank-fun stop-fun
|
(defun org-x-dag-bs-action-rankfold-children (bss default rank-fun stop-fun
|
||||||
|
@ -699,7 +710,9 @@ used for optimization."
|
||||||
(org-x-dag-bs-rankfold-children bss default
|
(org-x-dag-bs-rankfold-children bss default
|
||||||
(-on rank-fun #'get-local)
|
(-on rank-fun #'get-local)
|
||||||
(-compose stop-fun #'get-local)
|
(-compose stop-fun #'get-local)
|
||||||
(-compose trans-fun #'get-local))))
|
(-const nil)
|
||||||
|
(lambda (x as)
|
||||||
|
(funcall trans-fun (get-local x) as)))))
|
||||||
|
|
||||||
(defmacro org-x-dag-left (fmt &rest args)
|
(defmacro org-x-dag-left (fmt &rest args)
|
||||||
`(either :left (format ,fmt ,@args)))
|
`(either :left (format ,fmt ,@args)))
|
||||||
|
@ -875,7 +888,7 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(`(:sp-task :task-active ,d) (is-next d))
|
(`(:sp-task :task-active ,d) (is-next d))
|
||||||
(_ nil)))
|
(_ nil)))
|
||||||
|
|
||||||
(lambda (acc)
|
(lambda (acc _)
|
||||||
(pcase acc
|
(pcase acc
|
||||||
((or `(:sp-proj :proj-complete ,_)
|
((or `(:sp-proj :proj-complete ,_)
|
||||||
`(:sp-task :task-complete ,_)
|
`(:sp-task :task-complete ,_)
|
||||||
|
@ -980,7 +993,7 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
((equal it-todo org-x-kw-todo)
|
((equal it-todo org-x-kw-todo)
|
||||||
(org-x-dag-bs-action-subiter-todo-fold child-bss
|
(org-x-dag-bs-action-subiter-todo-fold child-bss
|
||||||
`(:si-active (:sched ,sched :dead ,dead))
|
`(:si-active (:sched ,sched :dead ,dead))
|
||||||
(lambda (acc)
|
(lambda (acc _)
|
||||||
(pcase acc
|
(pcase acc
|
||||||
(`(:si-complete ,_)
|
(`(:si-complete ,_)
|
||||||
(org-x-dag-left "Active sub-iterator must have at least one active child"))
|
(org-x-dag-left "Active sub-iterator must have at least one active child"))
|
||||||
|
@ -1001,7 +1014,7 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
;; TODO also check for timeshift and archive props
|
;; TODO also check for timeshift and archive props
|
||||||
((equal it-todo org-x-kw-todo)
|
((equal it-todo org-x-kw-todo)
|
||||||
(org-x-dag-bs-action-subiter-todo-fold child-bss '(:iter-empty)
|
(org-x-dag-bs-action-subiter-todo-fold child-bss '(:iter-empty)
|
||||||
(lambda (acc)
|
(lambda (acc _)
|
||||||
(pcase acc
|
(pcase acc
|
||||||
(`(:si-complete ,_) (either :right '(:iter-empty)))
|
(`(:si-complete ,_) (either :right '(:iter-empty)))
|
||||||
(`(:si-active ,ts-data)
|
(`(:si-active ,ts-data)
|
||||||
|
|
Loading…
Reference in New Issue