ast builder

ast.fsx

type Request<'i,'o,'k> = 'i * ('o -> 'k)
let bindRequest bind f (s,k) = s, fun v -> bind(k v,f)

type Toy<'r> =
  | Output of Request<string,unit,Toy<'r>>
  | Input of Request<unit, string,Toy<'r>>
  | Pure of 'r 

type ToyBuilder() =
    member x.Bind(v:Toy<'a>,f:'a->Toy<'b>) = 
        match v with
            | Output(r) -> Output(bindRequest x.Bind f r)
            | Input(r) -> Input(bindRequest x.Bind f r)
            | Pure(v) -> f(v)
    member x.Return v = Pure(v)

let toy = ToyBuilder()

let lift ctor i = ctor(i, fun s -> Pure(s))
    
let out = lift Output
let inp = lift Input

type Handler<'i,'o,'k> = 'i -> Lazy<'o * 'k>
let rec runI (request: Request<'i,'o,'r>) (handler: Handler<'i,'o,'k>) r = 
    let s1, k = request
    let s2, i2 = (handler s1).Force()
    r (k s2) i2

let coLift next w f x = lazy(let i, w2 = f w x
                             i, next w2)

let coLiftIO next w f x = lazy(let i = f x
                               i, next w)

type Interpreter<'k> = {
        outputH : Handler<string, unit, Interpreter<'k>>
        inputH : Handler<unit, string, Interpreter<'k>>;
        st:'k;
    }

let rec run ast i =
    match ast with
          | Output(r) -> runI r i.outputH run
          | Input(r) ->  runI r i.inputH run
          | Pure(v) -> i.st,v


//concrete interpreter
let coInput (inpList , outpList) () = 
                match inpList with 
                    | h :: t -> h, (t,outpList)
                    | _ -> failwith "noinput"
let coOutput (inpList :string list , outpList:string list) s = (), (inpList, (s::outpList))
let rec mkFake w = 
        {  
            outputH = coLift mkFake w <| coOutput
            inputH = coLift mkFake w <| coInput
            st = w;
        }

let rec mkConsole w = 
        {  
            inputH = coLiftIO mkConsole w <| System.Console.ReadLine
            outputH = coLiftIO mkConsole w <| printfn "%s" 
            st = w;
        }
//command
let program = toy{
    let a = "value"
    do! out(sprintf "enter %s" a)
    let! x = inp()
    return int(x)
} 

printfn "run interpret"
run program (mkFake (["10"], []) ) |> printfn "fake %A"
mkConsole () |> run program |> printfn "console %A"