Почему эта функция последовательности F # не является хвостовой рекурсией?

Основываясь на ответе Томаса, давайте определим два модуля:

module Kurt = 
    type Gen<'a> = Gen of (int -> 'a)

    let unit x = Gen (fun _ -> x)

    let bind k (Gen m) =     
        Gen (fun n ->       
            let (Gen m') = k (m n)       
            m' n)

    type GenBuilder() =
        member x.Return(v) = unit v
        member x.Bind(v,f) = bind f v

    let gen = GenBuilder()


module Tomas =
    type Gen<'a> = Gen of (int -> ('a -> unit) -> unit)

    let unit x = Gen (fun _ f -> f x)

    let bind k (Gen m) =     
        Gen (fun n f ->       
            m n (fun r ->         
                let (Gen m') = k r        
                m' n f))

    type GenBuilder() =
        member x.Return v = unit v
        member x.Bind(v,f) = bind f v

    let gen = GenBuilder()

Чтобы немного упростить ситуацию, давайте перепишем исходную функцию последовательности как

let rec sequence = function
| [] -> gen { return [] }
| m::ms -> gen {
    let! x = m
    let! xs = sequence ms
    return x::xs }

Теперь sequence [for i in 1 .. 100000 -> unit i] будет выполняться до завершения независимо от того, определено ли sequence в терминах Kurt.gen или Tomas.gen. Проблема не в том, что sequence вызывает переполнение стека при использовании ваших определений, а в том, что функция, возвращаемая вызовом sequence, вызывает переполнение стека при вызове это.

Чтобы понять, почему это так, давайте расширим определение sequence с точки зрения лежащих в его основе монадических операций:

let rec sequence = function
| [] -> unit []
| m::ms ->
    bind (fun x -> bind (fun xs -> unit (x::xs)) (sequence ms)) m

Вставив значения Kurt.unit и Kurt.bind и максимально упростив, мы получим

let rec sequence = function
| [] -> Kurt.Gen(fun _ -> [])
| (Kurt.Gen m)::ms ->
    Kurt.Gen(fun n ->
            let (Kurt.Gen ms') = sequence ms
            (m n)::(ms' n))

Теперь, надеюсь, понятно, почему вызов let (Kurt.Gen f) = sequence [for i in 1 .. 1000000 -> unit i] in f 0 переполняет стек: f требует не-хвостового рекурсивного вызова для упорядочивания и оценки результирующей функции, поэтому для каждого рекурсивного вызова будет один кадр стека.

Вместо этого, вставив Tomas.unit и Tomas.bind в определение sequence, мы получим следующую упрощенную версию:

let rec sequence = function
| [] -> Tomas.Gen (fun _ f -> f [])
| (Tomas.Gen m)::ms ->
    Tomas.Gen(fun n f ->  
        m n (fun r ->
            let (Tomas.Gen ms') = sequence ms
            ms' n (fun rs ->  f (r::rs))))

Рассуждать об этом варианте сложно. Вы можете эмпирически убедиться, что он не взорвет стек для некоторых произвольно больших входных данных (как показывает Томас в своем ответе), и вы можете выполнить оценку, чтобы убедиться в этом факте. Однако потребление стека зависит от Gen экземпляров в переданном списке, и можно взорвать стек для входных данных, которые сами по себе не являются хвостовой рекурсией:

// ok
let (Tomas.Gen f) = sequence [for i in 1 .. 1000000 -> unit i]
f 0 (fun list -> printfn "%i" list.Length)

// not ok...
let (Tomas.Gen f) = sequence [for i in 1 .. 1000000 -> Gen(fun _ f -> f i; printfn "%i" i)]
f 0 (fun list -> printfn "%i" list.Length)

Вы правы - причина, по которой вы получаете переполнение стека, заключается в том, что операция bind монады должна быть хвостовой рекурсией (поскольку она используется для агрегирования значений во время свертывания).

Монада, используемая в FsCheck, по сути является монадой состояния (она хранит текущий генератор и некоторое число). Я немного упростил и получил что-то вроде:

type Gen<'a> = Gen of (int -> 'a)

let unit x = Gen (fun n -> x)

let bind k (Gen m) = 
    Gen (fun n -> 
      let (Gen m') = k (m n) 
      m' n)

Здесь функция bind не является хвостовой рекурсией, потому что она вызывает k, а затем выполняет дополнительную работу. Вы можете изменить монаду на монаду-продолжение. Он реализован как функция, которая принимает состояние и продолжение — функцию, которая вызывается с результатом в качестве аргумента. Для этой монады можно сделать хвост bind рекурсивным:

type Gen<'a> = Gen of (int -> ('a -> unit) -> unit)

let unit x = Gen (fun n f -> f x)

let bind k (Gen m) = 
    Gen (fun n f -> 
      m n (fun r -> 
        let (Gen m') = k r
        m' n f))

В следующем примере не будет переполнения стека (и это произошло с исходной реализацией):

let sequence l = 
  let k m m' = 
    m |> bind (fun x ->
      m' |> bind (fun xs -> 
        unit (x::xs)))
  List.foldBack k l (unit [])

let (Gen f) = sequence [ for i in 1 .. 100000 -> unit i ]
f 0 (fun list -> printfn "%d" list.Length)