TablaM Experimental interpreter #4

Interpreter.fs

let rec eval (env : Stack) (ast : ExprC) = 
    let evalEnv = eval env
    match ast with
    //Basic values
    | PassC -> PassC
    | NoneC -> NoneC
    | BreakC -> BreakC
    | IntC _ as v -> v
    | BoolC _ as v -> v
    | DecC _ as v -> v
    | StrC _ as v -> v
    | ArrayC _ as v -> v
    | AgdtC(nameType, name, values) -> 
        let result = values |> Array.map evalEnv
        AgdtC(nameType, name, result)
    | DefAGDT(name, options) ->
        //Build constructors for the AGDT
        let makeBuilder nameType name (options:array<ExprC>) =
            let head = [
                for i in 0..options.Length-1 do
                    yield sprintf "%d" i
            ]
            let values = [
                for i in 0..options.Length-1 do
                    yield VAR(sprintf "%d" i)
            ]
            let result = values |> List.toArray

            let body = AgdtC(nameType, name, result)
            FUNFULL name head body
        let builders = [for op in options do
                            yield makeBuilder name op.Key op.Value]                        
        builders |> BlockC |> evalEnv
    //| AgdtC of string * string * array<ExprC>
    | SetVarC(name, value) -> 
        let r = match value with
                | FunC  _ as v -> v
                | _ -> value |> evalEnv
        env.setValue(name, r)
        PassC
    | VarC(name) -> 
        match env.readValue(name) with
        | Some(x) -> x
        | _ -> failwithf "%A variable is not defined" name
    | BlockC(lines) ->
        List.map evalEnv lines |> List.last
    | BinOpC(op, left, rigth) ->
        let l = left  |>evalEnv
        let r = rigth |>evalEnv
        operator op l r
    | FunC _ as v -> v
    | IfC(test, ifTrue, ifFalse) ->
        let result = evalEnv test |> extractBool
        if result then
            evalEnv ifTrue
        else
            evalEnv ifFalse
    | LoopC(condition, code) ->
         let mutable last = PassC
         let mutable loop = true

         while loop && extractBool(evalEnv condition) do
             last <- evalEnv code
             match last with
             | BreakC -> loop <- false
             | _ -> ()
         last
    | ForC(name, collection, body) ->
        //TODO: Desugar to LOOP
        let rows =
             match collection with
             | ArrayC(_, values) -> values
             | _ -> failwithf "%A is not iterable" collection

        let breakLoop = 
             fun x ->match x with
                     | BreakC -> false
                     | _ -> true

        let evalLoop x =
             let r = evalEnv x
             env.appendStack()
             env.setValue(name, x)
             let r = evalEnv body
             env.popStack()
             r

        let r= rows
                 |> Array.map evalLoop
                 |> Array.takeWhile breakLoop
                 |> Array.tryLast

        match r with
        | Some(x) -> x
        | _ -> PassC
    | CallNetC(assembly, methodOrProp, paramList) -> 
        PassC
    | CallFunC(name, callVars) -> 
        let fx = env.readValue(name)
        match fx with
        | Some(FunC(body, vars)) ->
            env.appendStack()

            for var in callVars do
                let name, value = extractParam var
                env.setValue(name, value |> evalEnv)
            let r = evalEnv body
            env.popStack()
            r
        | None -> failwithf "%A function is not defined" name
        | _ -> failwithf "%A is not a function" fx