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
