let levels d =
    map (fun a -> a []) (
        let zloz l p = fold_left (
            fun (f, w) e ->
                match f with
                | [] -> (f,e::w)
                | h::t -> (t,(fun a -> e (h a))::w)
            ) (p, []) l
        in let zloz_wrapper_dwa l p =
            if length l < length p then
                zloz l p
            else
                zloz p l
        in let zloz_wrapper l p =
            let (r,x) = zloz_wrapper_dwa l p in
            (rev x) @ r
        in
        fold_tree (fun w l r a -> (w::a)::(zloz_wrapper l r)) [] d
    );;

let rec zloz l p =
    match l, p with
    | [], _ -> p
    | _, [] -> l
    | (a::x, b::y) -> (function x -> a (b x))::(zloz x y)


let zloz l p = rev (snd (fold_left (
    fun (f, w) e ->
        match f with
        | [] -> (f,e::w)
        | h::t -> (t,(fun a -> e (h a))::w)
    ) (p, []) l))

let zloz l p = rev (snd (fold_left (
    fun (f, w) e ->
        match f with
        | [] -> (f,e::w)
        | h::t -> (t,(fun a -> e (h a))::w)
    ) (p, []) l))
in let zloz_wrapper l p =
    if length l < length p then
        zloz p l
    else
        zloz l p
in


let zloz l p = fold_left (
    fun (f, w) e ->
        match f with
        | [] -> (f,e::w)
        | h::t -> (t,(fun a -> e (h a))::w)
    ) (p, []) l
in let zloz_wrapper_dwa l p =
    if length l < length p then
        zloz l p
    else
        zloz p l
in let zloz_wrapper l p =
    let (r,x) = zloz_wrapper_dwa l p in
    (rev x) @ r

let levels t =
    let aux x fl fr =
        function
        | [] -> [x] :: (fl(fr []))
        | h::t -> [x @ h] :: (fl (fr t))
    in
        fold_tree aux (fun x -> x) t [];;