Abstract Syntax Tree

open System

type Ops = | Ldc of int32 | Ldl of string | Stl of string | Dim of string * Exp list
           | Ld32 | St32
           | Call of string | Jump of string | Lea of string | Func of string * Exp
           | For of Exp
           | If of Exp * Exp
           | Add | Sub | Neg | Mul | Muls | Div | Divs
           | And | Or | Eor | Bic | Not | Flag | NFLag
           | Lsl | Lsr | Asr | Ror
           | Dup | Drop | Swap | Over | Rot | NRot
           | Return
and Exp = Ops list

type Sym = Var of int32 | Fun of Exp
let symbols = Map.empty
let (array:int []) = Array.zeroCreate 16

let rec exec (sym,stk) inst =
        printfn "Stk: %A" (List.rev stk)
        printfn "Exe: %A" inst
        match inst,stk with
        | Ldc n,xs        -> (sym,n::xs)
        | Ldl a,xs        -> match Map.tryFind a sym with
                             | Some(Var n) -> (sym,n::xs)
                             | _ -> failwith "Unknown variable!"
        | Stl a, x::xs    -> (Map.add a (Var x) sym,xs)
        | Add, x::y::xs   -> (sym,x+y::xs)
        | Sub, x::y::xs   -> (sym,y-x::xs)
        | Neg, x::xs      -> (sym,-x::xs)
        | Mul, x::y::xs   -> (sym,x*y::xs)
        | Div, x::y::xs   -> (sym,y/x::xs)
        | And, x::y::xs   -> (sym,(x&&&y)::xs)
        | Or, x::y::xs    -> (sym,(x|||y)::xs)
        | Eor, x::y::xs   -> (sym,(x^^^y)::xs)
        | Bic, x::y::xs   -> (sym,(x&&&(~~~y))::xs)
        | Not, x::xs      -> (sym,~~~x::xs)
        | Lsl, x::y::xs   -> (sym,(y<<<x)::xs)
        | Lsr, x::y::xs   -> (sym,(int32((uint32 y)>>>x))::xs)
        | Asr, x::y::xs   -> (sym,(y>>>x)::xs)
        | Dup, x::xs      -> (sym,x::x::xs)
        | Drop, x::xs     -> (sym,xs)
        | Swap, x::y::xs  -> (sym,y::x::xs)
        | Over, x::y::xs  -> (sym,y::x::y::xs)
        | Ld32, x::xs     -> (sym,array.[x]::xs) 
        | St32, x::y::xs  -> array.[x] <- y
                             (sym,xs) 
        | If (t,f), c::xs -> if c <> 0
                             then run (sym,xs) t
                             else run (sym,xs) f
        | For c,i::xs     -> let rec loop (sym,stk) i =
                              if i <= 0 then (sym,stk)
                              else loop (run (sym,stk) c) (i - 1)
                             loop (sym,xs) i
        | Func (s,c),xs   -> (Map.add s (Fun c) sym,xs)
        | Call f,xs       -> match Map.tryFind f sym with
                             | Some(Fun f) -> run (sym,xs) f
                             | _ -> failwithf "Unknown function '%s'!" f
        | _,[]            -> failwith "Stack underflow!"
        | op,_            -> failwithf "Unknown instruction '%A'!" op
    
and run (symbols,stack) code = List.fold exec (symbols,stack) code


[<EntryPoint>]
let main argv =
    let prg = [ Func ("LSL",[For [Dup; Add]])
                Func ("LSR",[For [Ldc 2; Div]])
                Ldc 1920
                Ldc 1080
                Stl "xRes"
                Stl "yRes"
                Ldl "xRes"
                Ldl "yRes"
                Mul
                Ldc 2
                Call "LSL" 
              ]

    let (sym,stk) = run (symbols,[]) prg
    printfn "Stk: %A" (List.rev stk)

    printfn "\nSymbols:"
    for s in sym do
        match s.Value with
        | Var n -> printfn "Variable: %s = %A" s.Key n
        | Fun n -> printfn "Function: %s = %A" s.Key n
    
    printfn "\nContent of Data stack:"
    List.iter (printfn "%A") stk
        

    0 // return an integer exit code