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

Question

Раскрытие: это появилось в FsCheck, фреймворке случайного тестирования F #, который я поддерживаю.У меня есть решение, но оно мне не нравится.Более того, я не понимаю проблемы - она ​​была просто обойдена.

Довольно стандартная реализация (монадической, если мы собираемся использовать большие слова) последовательности:

let sequence l = 
    let k m m' = gen { let! x = m
                       let! xs = m'
                       return (x::xs) }
    List.foldBack k l (gen { return [] })

Где gen может быть заменен выбранным компоновщиком вычислений.К сожалению, эта реализация потребляет пространство стека, и поэтому в конечном итоге переполнение стека, если список достаточно длинный. Вопрос в том, почему?Я в принципе знаю, что foldBack не является хвостовой рекурсией, но умные кролики команды F # обошли это в реализации foldBack.Есть ли проблема в реализации компоновщика вычислений?

Если я изменю реализацию на приведенную ниже, все в порядке:

let sequence l =
    let rec go gs acc size r0 = 
        match gs with
        | [] -> List.rev acc
        | (Gen g)::gs' ->
            let r1,r2 = split r0
            let y = g size r1
            go gs' (y::acc) size r2
    Gen(fun n r -> go l [] n r)

Для полноты можно найти тип Gen и конструктор вычислений в источнике FsCheck

Answer 1

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

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, вызывает переполнение стека при вызове it .

Чтобы понять, почему это так, давайте расширим определение 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)

Answer 2

Вы правы - причина, по которой вы получаете переполнение стека, заключается в том, что операция 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 tail рекурсивным:

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)