Skip to content

Instantly share code, notes, and snippets.

@mamcx
Created March 9, 2016 21:35
Show Gist options
  • Save mamcx/b4184ee95c174e9e8077 to your computer and use it in GitHub Desktop.
Save mamcx/b4184ee95c174e9e8077 to your computer and use it in GitHub Desktop.
TablaM Experimental interpreter #4
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment