@ -47,25 +47,27 @@ module Partition = struct
( fold_heads [ @ tailcall ] ) next ~ init ~ f
( fold_heads [ @ tailcall ] ) next ~ init ~ f
let rec expand ~ fold_right partition =
let expand ~ fold_right partition =
match partition with
let rec expand_aux ~ cb = function
| Empty ->
| Empty ->
Empty
cb Empty
| Node { node ; next } ->
| Node { node ; next } ->
let init = expand ~ fold_right next in
( expand_aux [ @ tailcall ] ) next ~ cb : ( fun init ->
fold_right node ~ init ~ f : prepend_node
fold_right node ~ init ~ f : prepend_node | > cb )
| Component { head ; rest ; next } -> (
| Component { head ; rest ; next } ->
let next = expand ~ fold_right next in
( expand_aux [ @ tailcall ] ) next ~ cb : ( fun next ->
let init = expand ~ fold_right rest in
( expand_aux [ @ tailcall ] ) rest ~ cb : ( fun init ->
match fold_right head ~ init ~ f : prepend_node with
match fold_right head ~ init ~ f : prepend_node with
| Empty | Component _ ->
| Empty | Component _ ->
(* [fold_right] is expected to always provide a non-empty sequence.
(* [fold_right] is expected to always provide a non-empty sequence. Hence the
Hence the result of [ fold_right ~ f : prepend_node ] will always start with a Node . * )
result of [ fold_right ~ f : prepend_node ] will always start with a Node . * )
Logging . ( die InternalError )
Logging . ( die InternalError )
" WeakTopologicalOrder.Partition.expand: the expansion function fold_righ t should no t \
" WeakTopologicalOrder.Partition.expand: the expansion function fold_righ t \
return ~ init directly "
should not return ~ init directly "
| Node { node = head ; next = rest } ->
| Node { node = head ; next = rest } ->
Component { head ; rest ; next } )
cb ( Component { head ; rest ; next } ) ) )
in
expand_aux ~ cb : IStd . ident partition
let rec pp ~ prefix ~ pp_node fmt = function
let rec pp ~ prefix ~ pp_node fmt = function