Может ли оператор (вперед) трубы предотвращать оптимизацию хвостового вызова?

Ответ 1

Основываясь на минимальном случае, как предусмотрено, если код запускается в режиме деблокирования в 64-битном режиме, он терпит неудачу с переполнением стека. Если код запускается в режиме деблокирования в 32-битном режиме, он преуспевает.

Примечание. Опция выбора между 32-битным и 64-разрядным значениями - Prefer 32-bit, как показано на изображениях ниже.

Увеличение размера стека приведет к тому, что код будет работать в режиме деблокирования в 64-битном режиме. Это делается с помощью конструктора .

[<EntryPoint>]
let main _ =

    let test () =
        let r = KissRandom()
        let n = r.Normal()
        Seq.item 20000 n |> printfn "%f"

    /// The greatest maximum-stack-size that should be used
    /// with the 'runWithStackFrame' function.
    let STACK_LIMIT = 16777216

    /// Run a function with a custom maximum stack size.
    /// This is necessary for some functions to execute
    /// without raising a StackOverflowException.
    let runWithCustomStackSize maxStackSize fn =
        // Preconditions
        if maxStackSize < 1048576 then
            invalidArg "stackSize" "Functions should not be executed with a \
                maximum stack size of less than 1048576 bytes (1MB)."
        elif maxStackSize > STACK_LIMIT then
            invalidArg "stackSize" "The maximum size of the stack frame should \
                not exceed 16777216 bytes (16MB)."

        /// Holds the return value of the function.
        let result = ref Unchecked.defaultof<'T>

        // Create a thread with the specified maximum stack size,
        // then immediately execute the function on it.
        let thread = System.Threading.Thread ((fun () -> result := fn()), maxStackSize)
        thread.Start ()

        // Wait for the function/thread to finish and return the result.
        thread.Join ()
        !result

    /// Runs a function within a thread which has an enlarged maximum-stack-size.
    let inline runWithEnlargedStack fn =
        runWithCustomStackSize STACK_LIMIT fn


//    test ()       // Fails with Qaru in 64-bit mode, Release
                    // Runs successfully in 32-bit mode, Release

    runWithEnlargedStack test

    printf "Press any key to exit: "
    System.Console.ReadKey() |> ignore
    printfn ""

    0

Этот код из FSharp-logic-examples и, в частности, Anh-Dung Phan

Пока я не проверял основную причину, я подозреваю, что из-за размера элементов для 64-бит больше размера элементов для 32-битного и даже если количество элементов, помещенных в стек и размер стека остаются одинаковыми для обеих версий, увеличение размера элемента увеличивает объем памяти, необходимый для стека, в пределах 1 мегабайта.

TL; DR

Это был интересный и просветительский вопрос. Я рад, что меня спросили.

Первоначально проблема оказалась связанной с использованием |> и TCO, и поскольку это все еще значение, я оставляю это в ответе. Я также хотел бы поблагодарить ОП за то, что он был откликом и полезным, приятно помогать тому, кто работает с вами, а не против вас.

В следующем коде, который является рекурсивным и имеет |>, выполняется в режиме отладки в Visual Studio, он вызывает StackOverflow.

Если он запущен из командной строки из каталога bin\release, он НЕ вызывает StackOverflow.

Использование сообщества Visual Studio 15

[<EntryPoint>]
let main argv = 

    let largeList = 
        printfn "Creating large list"
        [
            for i in 1 .. 100000000 do
                yield i
        ]

    // causes StackOverflow in Debug
    // No StackOverflow in Release
    let sum4 l =
        printfn "testing sum4"
        let rec sumInner4 l acc =
            match l with
            | h::t -> 
                let acc = acc + h
                acc |> sumInner4 t
            | [] -> acc
        sumInner4 l 0

    let result4 = sum4 largeList
    printfn "result4: %A" result4

Если в панели инструментов Visual Studio установлен Release или Debug

а параметры проекта в режиме отладки

а параметры проекта в режиме выпуска

TL;DR;

В процессе тестирования я создал 16 различных тестов и построил их как в режиме отладки, так и в режиме выпуска и проверял, выполнили ли они выполнение или выбросили переполнение стека. 16 разбиты на 4 группы по 4 случая. Случаи 1,5,9,13 являются отрицательными и создают переполнение стека, чтобы обеспечить возможность. Случаи 2,6,10,14 являются положительными, чтобы показать, что хвостовой вызов работает и не вызывает переполнение стека. Случаи 3,7,11,15 показывают хвостовой вызов с операцией, выполненной в том же выражении, что и хвостовой вызов, и быть одной факторизацией вдали от тестовых примеров с использованием |>; они работают, как ожидалось. Случаи 4,8,12,16 используют |> и показывают, когда это происходит и не работают в режиме отладки, что, вероятно, является неожиданностью для многих. Случаи 1-4 и 9-12 используют функцию формы f x y, случаи 8-11 используют функцию формы f x, а случаи 12-16 используют функцию вида f x y z. Я изначально выполнил первые 8 тестовых случаев, но после того, как комментарий Кита сделал еще 4, которые не используют список, но все же используют функцию от f x y и представляют неожиданный результат, а затем сделали еще 4, которые используют функцию формы f x y z.

Чтобы запустить тест, вам нужно будет прокомментировать все, кроме одного теста, который вы планируете запустить, и построить его один раз в режиме отладки, который затем можно запустить из Visual Studio, а затем снова создать в режиме деблокирования и запустить его. Я запускаю его из командной строки, чтобы убедиться, что запускаю версию.

[<EntryPoint>]
let main argv = 

    let largeList = 
        printfn "Creating large list"
        [
            for i in 1 .. 100000000 do
                yield i
        ]

    // causes StackOverflow in Debug
    // causes StackOverflow in Release
    //   Negative confirmation
    //   A supposed tail call that DOES cause a Qaru in both debug and release mode
    //   options: f x y
    let sum1 l = 
        printfn "test 01: "
        let rec sum1Inner l acc =
            match l with
            | h::t -> 
                let acc = acc + h
                1 + sum1Inner t acc
            | [] -> acc
        sum1Inner l 0

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //   Positive confirmation
    //   A tail call that DOES NOT cause a Qaru in both debug and release mode
    //   options: f x y
    let sum2 l =
        printfn "test 02: "
        let rec sum2Inner l acc =
            match l with
            | h::t -> 
                let acc = acc + h
                sum2Inner t acc
            | [] -> acc
        sum2Inner l 0

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //   A test case
    //   options: f x y and no |>
    let sum3 l =
        printfn "test 03: "
        let rec sum3Inner l acc =
            match l with
            | h::t -> 
                sum3Inner t (acc + h)
            | [] -> acc
        sum3Inner l 0

    // causes StackOverflow in Debug
    // No StackOverflow in Release
    //   A test case
    //   options: f x y and |>
    let sum4 l =
        printfn "test 04: "
        let rec sum4Inner l acc =
            match l with
            | h::t -> 
                let acc = acc + h
                acc |> sum4Inner t
            | [] -> acc
        sum4Inner l 0

    // causes StackOverflow in Debug
    // causes StackOverflow in Release
    //   Negative confirmation
    //   A supposed tail call that DOES cause a Qaru in both debug and release mode
    //   options: f x
    let sum5 () =
        printfn "test 05: "
        let rec sum5Inner x =
            match x with 
            | 10000000 -> x
            | _ -> 
                let acc = x + 1
                1 + sum5Inner acc
        sum5Inner 0

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //   Positive confirmation
    //   A tail call that DOES NOT cause a Qaru in both debug and release mode
    //   options: f x
    let sum6 () =
        printfn "test 06: "
        let rec sum6Inner x =
            match x with 
            | 10000000 -> x
            | _ -> 
                let acc = x + 1
                sum6Inner acc
        sum6Inner 0

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //  A test case
    //  options: f x and no |>
    let sum7 l =
        printfn "test 07: "
        let rec sum7Inner x =
            match x with 
            | 10000000 -> x
            | _ -> sum7Inner (x + 1)
        sum7Inner 0

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //   A test case
    //   options: f x and |>
    let sum8 () =
        printfn "test 07: "
        let rec sumInner8 x =
            match x with
            | 10000000 -> x
            | _ -> 
                let acc = x + 1
                acc |> sumInner8 
        sumInner8 0

    // causes StackOverflow in Debug
    // causes StackOverflow in Release
    //   Negative confirmation"
    //   A supposed tail call that DOES cause a Qaru in both debug and release mode"
    //   options: f x y"
    let sum9 () = 
        printfn "test 09: "
        let rec sum9Inner x y =
            match y with
            | 10000000 -> y
            | _ -> 
                let acc = x + y
                1 + sum9Inner x acc
        sum9Inner 1 0   

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //   Positive confirmation
    //   A tail call that DOES NOT cause a Qaru in both debug and release mode
    //   options: f x y
    let sum10 () =
        printfn "test 10: "
        let rec sum10Inner x y =
            match y with
            | 10000000 -> y
            | _ -> 
                let acc = x + y
                sum10Inner x acc
        sum10Inner 1 0

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //   A test case
    //   options: f x y and no |>
    let sum11 () =
        printfn "test 11: "
        let rec sum11Inner x y =
            match y with
            | 10000000 -> y
            | _ -> 
                sum11Inner x (x + y) 
        sum11Inner 1 0

    // causes StackOverflow in Debug
    // No StackOverflow in Release
    //   A test case
    //   options: f x y and |>
    let sum12 () =
        printfn "test 12: "
        let rec sum12Inner x y =
            match y with
            | 10000000 -> y
            | _ -> 
                let acc = x + y
                acc |> sum12Inner x
        sum12Inner 1 0

    // causes StackOverflow in Debug
    // No StackOverflow in Release
    //   A test case"
    //   options: f x y and |>"
    let sum12 () =
        printfn "test 12: "
        let rec sum12Inner x y =
            match y with
            | 10000000 -> y
            | _ -> 
                let acc = x + y
                acc |> sum12Inner x
        sum12Inner 1 0

    // causes StackOverflow in Debug
    // causes StackOverflow in Release
    //   Negative confirmation"
    //   A supposed tail call that DOES cause a Qaru in both debug and release mode"
    //   options: f x y"
    let sum13 () = 
        printfn "test 13: "
        let rec sum13Inner x z y =
            match y with
            | 10000000 -> y
            | _ -> 
                let acc = x + y
                1 + sum13Inner x z acc 
        sum13Inner 1 "z" 0

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //   Positive confirmation"
    //   A tail call that DOES NOT cause a Qaru in both debug and release mode"
    //   options: f x y"
    let sum14 () =
        printfn "test 14: "
        let rec sum14Inner x z y =
            match y with
            | 10000000 -> y
            | _ -> 
                let acc = x + y
                sum14Inner x z acc
        sum14Inner 1 "z" 0

    // No StackOverflow in Debug
    // No StackOverflow in Release
    //   A test case"
    //   options: f x y and no |>"
    let sum15 () =
        printfn "test 15: "
        let rec sum15Inner x z y =
            match y with
            | 10000000 -> y
            | _ -> 
                sum15Inner x z (x + y) 
        sum15Inner 1 "z" 0

    // causes StackOverflow in Debug
    // No StackOverflow in Release
    //   A test case"
    //   options: f x y and |>"
    let sum16 () =
        printfn "test 16: "
        let rec sum16Inner x z y =
            match y with
            | 10000000 -> y
            | _ -> 
                let acc = x + y
                acc |> sum16Inner x z
        sum16Inner 1 "z" 0

    let result1 = sum1 largeList
    printfn "result1: %A" result1

    let result2 = sum2 largeList
    printfn "result2: %A" result2

    let result3 = sum3 largeList
    printfn "result3: %A" result3

    let result4 = sum4 largeList
    printfn "result4: %A" result4

    let result5 = sum5 ()
    printfn "result5: %A" result5

    let result6 = sum6 ()
    printfn "result6: %A" result6

    let result7 = sum7 ()
    printfn "result7: %A" result7

    let result8 = sum8 ()
    printfn "result8: %A" result8

    let result9 = sum9 ()
    printfn "result9: %A" result9

    let result10 = sum10 ()
    printfn "result10: %A" result10

    let result11 = sum11 ()
    printfn "result11: %A" result11

    let result12 = sum12 ()
    printfn "result12: %A" result12

    let result13 = sum13 ()
    printfn "result13: %A" result13

    let result14 = sum14 ()
    printfn "result14: %A" result14

    let result15 = sum15 ()
    printfn "result15: %A" result15

    let result16 = sum16 ()
    printfn "result16: %A" result16

    printf "Press any key to exit: "
    System.Console.ReadKey() |> ignore
    printfn ""

    0 // return an integer exit code