free tests

free.fsx

type Toy<'r, 'next> =
  | Output of 'r * 'next
  | Bell of 'next
  | Done

let fmap f a =
    match a with
          | Output (x,next) -> Output (a,f next)
          | Bell(next) -> Bell(f next)
          | Done -> Done

let Free<'f,'a> =
    | Free of 'a 
    | Pure of 'a





//type CoToy<'r> =  {
//                    OutputH : string * Toy<'r>;
//                    InputH : string -> Toy<'r>;
//                    ExitH : unit;
//                    Pure : 'r
//                  }

type ToyBuilder() =
    member x.Bind(v:Free<'a>,f:'a->Free<'b>) = 
        match v with
            | Free(Output(s,r)) -> Output(s,x.Bind(r,f))
            | Free(Input k) -> Input(fun v -> x.Bind(k(v),f))
            | Free(Exit) -> Free(Exit)
            | Pure(v) -> f(v)

    member x.Return v = Pure(v)

let toy = ToyBuilder()
    
let rec run ast=
    match ast with
          | Output (s,k) -> printfn "%s" s
                            run k
          | Input f -> run <| f(System.Console.ReadLine()) 
          | Pure(v) -> Some(v)
          | Exit -> None

let rec runFake inputs ast =
    match ast with
          | Output (s,k) -> printfn "%s" s
                            runFake inputs k
          | Input f -> match inputs with
                            | h :: t -> printfn "fake input %A" h
                                        runFake t <| f(h)
                            | [] -> failwith "no input"
          | Pure(v) -> Some(v)
          | Exit -> None

let exit () = Exit
let out s = Output(s, Pure())
let inp () = Input(fun s -> Pure(s))

let program = toy{
    let a = "value"
    do! out(sprintf "enter %s" a)
    let! x = inp()
    return int(x)
} 

program |> run
program |> runFake ["1"]