mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-30 10:38:19 +00:00
83 lines
2.6 KiB
OCaml
83 lines
2.6 KiB
OCaml
|
open GT
|
||
|
|
|
||
|
|
@type expr =
|
||
|
|
| Const of int
|
||
|
|
| Var of string
|
||
|
|
| Add of expr * expr
|
||
|
|
| Mul of expr * expr with show, html, gmap
|
||
|
|
|
||
|
|
let rec eval state expr =
|
||
|
|
match expr with
|
||
|
|
| Const n -> n
|
||
|
|
| Var x -> state x
|
||
|
|
| Add (e1, e2) -> eval state e1 + eval state e2
|
||
|
|
| Mul (e1, e2) -> eval state e1 * eval state e2
|
||
|
|
;;
|
||
|
|
|
||
|
|
@type stmt =
|
||
|
|
| Skip
|
||
|
|
| Assign of string * expr
|
||
|
|
| Read of string
|
||
|
|
| Write of expr
|
||
|
|
| Seq of stmt * stmt with show, html, gmap
|
||
|
|
|
||
|
|
let run input stmt =
|
||
|
|
let rec run' (state, output, input) stmt =
|
||
|
|
let eval' e = eval (fun x -> List.assoc x state) e in
|
||
|
|
match stmt with
|
||
|
|
| Skip -> (state, output, input)
|
||
|
|
| Assign (x, e) -> ((x, eval' e)::state, output, input)
|
||
|
|
| Write e -> (state, output @ [eval' e], input)
|
||
|
|
| Seq (s1, s2) -> run' (run' (state, output, input) s1) s2
|
||
|
|
| Read x ->
|
||
|
|
(match input with
|
||
|
|
| [] -> failwith "empty input"
|
||
|
|
| y :: input' -> ((x, y)::state, output, input')
|
||
|
|
)
|
||
|
|
in
|
||
|
|
let (_, output, _) = run' ([], [], input) stmt in
|
||
|
|
output
|
||
|
|
;;
|
||
|
|
|
||
|
|
@type instr =
|
||
|
|
| S_READ
|
||
|
|
| S_WRITE
|
||
|
|
| S_PUSH of int
|
||
|
|
| S_LD of string
|
||
|
|
| S_ST of string
|
||
|
|
| S_ADD
|
||
|
|
| S_MUL with show, html, gmap
|
||
|
|
|
||
|
|
let srun input code =
|
||
|
|
let rec srun' (state, stack, input, output) code =
|
||
|
|
match code with
|
||
|
|
| [] -> output
|
||
|
|
| instr :: code' ->
|
||
|
|
srun' (match instr with
|
||
|
|
| S_READ -> (match input with y::input' -> (state, y::stack, input', output ) | [] -> failwith "empty input" )
|
||
|
|
| S_WRITE -> (match stack with y::stack' -> (state, stack' , input , output @ [y]) | [] -> failwith "stack underflow")
|
||
|
|
| S_PUSH n -> (state, n::stack, input, output)
|
||
|
|
| S_LD x -> (state, (List.assoc x state)::stack, input, output)
|
||
|
|
| S_ST x -> (match stack with y::stack' -> ((x, y)::state, stack, input, output) | [] -> failwith "stack underflow")
|
||
|
|
| S_ADD -> (match stack with x::y::stack' -> (state, (y+x)::stack', input, output) | [] -> failwith "stack underflow")
|
||
|
|
| S_MUL -> (match stack with x::y::stack' -> (state, (y*x)::stack', input, output) | [] -> failwith "stack underflow")
|
||
|
|
)
|
||
|
|
code'
|
||
|
|
in
|
||
|
|
srun' ([], [], input, []) code
|
||
|
|
|
||
|
|
let rec compile_expr expr =
|
||
|
|
match expr with
|
||
|
|
| Var x -> [S_LD x]
|
||
|
|
| Const n -> [S_PUSH n]
|
||
|
|
| Add (e1, e2) -> compile_expr e1 @ compile_expr e2 @ [S_ADD]
|
||
|
|
| Mul (e1, e2) -> compile_expr e1 @ compile_expr e2 @ [S_MUL]
|
||
|
|
|
||
|
|
let rec compile_stmt stmt =
|
||
|
|
match stmt with
|
||
|
|
| Skip -> []
|
||
|
|
| Assign (x, e) -> compile_expr e @ [S_ST x]
|
||
|
|
| Read x -> [S_READ; S_ST x]
|
||
|
|
| Write e -> compile_expr e @ [S_WRITE]
|
||
|
|
| Seq (s1, s2) -> compile_stmt s1 @ compile_stmt s2
|