TablaM Third experimental interpreter

Program.fsx

open System.Collections.Generic

let genericTimer anyFunc input = 
    let stopwatch = System.Diagnostics.Stopwatch()
    stopwatch.Start()
    let result = anyFunc input //evaluate the function
    printfn "elapsed ms is %A" stopwatch.ElapsedMilliseconds
    result

let print ast = printfn "%A" ast

type MathOp = 
    | Add
    | Sub
    | Mul
    | Div

type LogicalOp = 
    | And
    | Or
    | Not
    | Equal
    | NotEqual
    | LessEqual
    | Less
    | GreaterEqual
    | Greater

type ValueC<'T> = 
    | ValueC of int * array<'T>

type MethodInfo = System.Reflection.MethodInfo

type ExprC = 
    | PassC
    | ParamC of string
    | DecC of decimal ValueC
    | BlockC of ExprC list
    | MathOpC of MathOp * ExprC
    | DefFunC of string * ExprC * ExprC
    | CallFunC of string * ExprC

//| NativeCallC of MethodInfo * ExprC []
type Env = Dictionary<string, ExprC>

type Reduction = 
    | IntFun of (int [] -> int)
    | DecFun of (decimal [] -> decimal)

let scalar (x : array<'T>) = ValueC(0, x)
let array (x : array<'T>) = ValueC(1, x)

let extractValue value = 
    match value with
    | ValueC(rank, d) -> rank, d

let extractDec value = 
    match value with
    | DecC(d) -> d |> extractValue
    | _ -> failwithf "%A is not a decimal number" value

let extractParam value = 
    match value with
    | ParamC(v) -> v
    | _ -> failwithf "%A is not a parameter" value

let newEnv() = new Env()
let lookupEnv (env : Env, name) = env.[name]
let extendEnv (env : Env, name, value) = env.[name] <- value

let rec eval (ast : ExprC, env : Env) = 
    match ast with
    //Basic values
    | PassC -> PassC
    | DecC(v) -> DecC(v)
    | ParamC(v) -> ParamC(v)
    | BlockC(lines) -> 
        for line in lines do
            eval (line, env) |> ignore
        PassC
    | MathOpC(op, values) -> 
        let num = 
            match op with
            | Add -> reduce (values, env, Array.reduce (+) |> DecFun)
            | Sub -> reduce (values, env, Array.reduce (-) |> DecFun)
            | Mul -> reduce (values, env, Array.reduce (*) |> DecFun)
            | Div -> reduce (values, env, Array.reduce (/) |> DecFun)
        num
    | DefFunC(name, vars, body) -> 
        extendEnv (env, name, DefFunC(name, vars, body))
        PassC
    | CallFunC(name, vars) -> 
        let fx = lookupEnv (env, name)
        let values = eval (vars, env)
        match fx with
        | DefFunC(name, prams, body) -> 
            let p = extractParam prams
            extendEnv (env, p, values)
            eval (body, env)
        | _ -> failwithf "%A is not a function" fx

and reduce (ast : ExprC, env : Env, fx : Reduction) = 
    let values = eval (ast, env)
    match fx with
    | IntFun(x) -> PassC
    | DecFun(x) -> 
        let rank, v = extractDec values
        let num = x v
        DecC(scalar [| num |])

let DECS(values) = 
    values
    |> array
    |> DecC

let ADD(values) = MathOpC(Add, values |> DECS)
let PRINT(value) = CallFunC("print", value)
let PARAM value = value |> ParamC

let PRINTVAL value = 
    value |> print
    PassC

let FUNPRINT = 
    let head = PARAM "value"
    let fx = PRINTVAL head
    DefFunC("print", head, fx)

let test = 
    let env = newEnv()
    
    let ast = 
        [ FUNPRINT
          ADD([| 1m; 2m |]) |> PRINT ]
    ast |> print
    let r = eval (ast |> BlockC, env)
    print r

[<EntryPoint>]
let main argv = test; 0 // return an integer exit code