Overflowing stack when composing lots of functions together

Here is one way of flattening a binary search tree. Its problem is that the stack overflows when the large function it builds is finally applied to []. I would like to know if there is a reasonable way of fixing this code fragment without completely changing how it works. For example, it would not help make progress to build a custom composer that builds a tree of functions, then evaluates them using an explicit stack (since the problem already is to flatten a tree).

let flatten_k t =

    let rec f t (k:(list<'a>->list<'a>)->list<'a>) =
        match t with
        | Leaf -> 
            k (fun xs -> xs)

        | Bin (l,x,r) ->
            f l (fun fl -> f r (fun fr -> k (fl << (fun xs -> x::xs) << fr)))

    f t (fun g -> g [])

It may be that it's better to think about a simplified instance, though it may be harder to convincingly demonstrate a fix on it (since it does close to nothing, though at least it shows that function composition does overflow the stack):

let test_composition () =
   let mutable f = id
   for i=0 to 1000000 do
       f <- id << f // >> works fine for me
   printf "Functions return %d" (f 123)

Again, this question is not about how to flatten a tree. I can easily do that as follows, or in any number of purely imperative ways. I want to know if an approach based on accumulating a large function can be made viable for this particular problem. Many thanks.

 let flatten t =

    let rec f t acc cont =
        match t with
        | Leaf ->
            cont acc

        | Bin (l, x, r) ->
            f r acc (fun rs -> f l (x::rs) cont)

    f t [] id