Cont.fs

module Cont

type Cont<'r, 'a> = ('a -> 'r) -> 'r

let cont (f: ('a -> 'r) -> 'r) : Cont<'r, 'a> = f

let bind (m: Cont<'r, 'a>) (f: 'a -> Cont<'r, 'b>) : Cont<'r, 'b> = fun k -> m (fun a -> f a k)

let callCC (f: ('a -> Cont<'r, 'b>) -> Cont<'r, 'a>) : Cont<'r, 'a> =
    fun k ->
        let exit = fun a -> fun _ -> k a
        f exit k

let runCont (m: Cont<'r, 'a>) (k: 'a -> 'r) : 'r = m k

let returnCont v = cont (fun k -> k v)

let inline (>>=) m f = bind m f

let rec foldM (f: 'a -> 'b -> Cont<'r, 'a>) (init: 'a) (xs: 'b list) : Cont<'r, 'a> =
    match xs with
    | [] -> returnCont init
    | x :: xs' -> bind (f init x) (fun acc -> foldM f acc xs')

type ContBuilder() =
    member _.Bind(m, f) = bind m f
    member _.Return(v) = returnCont v
    member _.ReturnFrom(m: Cont<'r, 'a>) = m
    member _.Delay(f) = cont (fun k -> runCont (f ()) k)
    member _.Zero() = returnCont ()
    member _.Combine(m1, m2) = bind m1 (fun _ -> m2)

    member _.For(sequence: seq<'a>, body: 'a -> Cont<'r, unit>) =
        cont (fun k ->
            use enumerator = sequence.GetEnumerator()

            let rec loop () =
                if enumerator.MoveNext() then
                    runCont (body enumerator.Current) (fun () -> loop ())
                else
                    k ()

            loop ())

    member _.TryWith(m, handler) =
        cont (fun k ->
            try
                runCont m k
            with e ->
                runCont (handler e) k)

    member _.TryFinally(m, compensation) =
        cont (fun k ->
            try
                runCont m k
            finally
                compensation ())

let continuation = ContBuilder()

Program.fs

open Cont

(* 実験1 *)

// ヘルパー関数
let printCont (message: string) =
    cont (fun k ->
        printfn "%s" message
        k ())

let readIntCont () =
    cont (fun k ->
        printf "Enter a number: "
        let input = System.Console.ReadLine()

        match System.Int32.TryParse(input) with
        | true, num -> k num
        | false, _ ->
            printfn "Invalid input. Please enter a valid number."
            k -1 // 無効な入力の場合は-1を返す
    )

// 数当てゲーム
let guessNumberGame (targetNumber: int) (maxAttempts: int) =
    callCC (fun exit ->
        continuation {
            for attempt in 1..maxAttempts do
                do! printCont (sprintf "Attempt %d of %d" attempt maxAttempts)
                let! guess = readIntCont ()

                if guess = targetNumber then
                    do! printCont (sprintf "Congratulations! You guessed the number %d correctly!" targetNumber)
                    return! exit attempt // 正解の場合、ゲームを終了
                elif guess < targetNumber then
                    do! printCont "Too low. Try again."
                else
                    do! printCont "Too high. Try again."

            // 最大試行回数に達した場合
            return maxAttempts
        })

// ゲームの実行
let targetNumber = 42
let maxAttempts = 5

let result =
    runCont (guessNumberGame targetNumber maxAttempts) (fun attempts ->
        if attempts = maxAttempts then
            printfn "Sorry, you've run out of attempts. The number was %d." targetNumber
        else
            printfn "You guessed the number in %d attempts." attempts

        attempts)

printfn "Game ended with result: %d" result



(* 実験2 *)

// テスト用の補助関数
let printCont (message: string) : Cont<'r, unit> =
    cont (fun k ->
        printfn "%s" message
        k ())

// 外側で callCC を使用し、continuation コンピュテーション式を使用する関数
let safeDivWithOuterExitAndCE (initVal: int) (list: int list) =
    callCC (fun exit ->
        let folder (acc: int) (x: int) =
            continuation {
                if x = 0 then
                    do! printCont "Division by zero encountered. Terminating..."
                    return! exit acc
                else
                    let result = acc / x
                    do! printCont $"{acc} / {x} = {result}"

                    if result < 10 then
                        do! printCont "Result is less than 10. Terminating early."
                        return! exit result
                    else
                        return result
            }

        foldM folder initVal list)

// テスト
let numbers = [ 2; 2; 3; 0; 5 ]
let initialValue = 100

let result2 = runCont (safeDivWithOuterExitAndCE initialValue numbers) id

printfn "Final result2: %d" result2