mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-25 16:18:48 +00:00
Strings/arrays/builtins in int/sm
This commit is contained in:
Dmitry Boulytchev
parent
b19bea4d58
commit
dd5956d663
10991 changed files with 24197 additions and 24039 deletions
|
|
@ -6,7 +6,9 @@ let parse infile =
|
|||
(object
|
||||
inherit Matcher.t s
|
||||
inherit Util.Lexers.decimal s
|
||||
inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "then"; "else"; "elif"; "fi"; "while"; "do"; "od"; "repeat"; "until"; "for"; "fun"; "local"; "return"] s
|
||||
inherit Util.Lexers.string s
|
||||
inherit Util.Lexers.char s
|
||||
inherit Util.Lexers.ident ["skip"; "if"; "then"; "else"; "elif"; "fi"; "while"; "do"; "od"; "repeat"; "until"; "for"; "fun"; "local"; "return"; "length"] s
|
||||
inherit Util.Lexers.skip [
|
||||
Matcher.Skip.whitespaces " \t\n";
|
||||
Matcher.Skip.lineComment "--";
|
||||
|
|
|
|||
171
src/Language.ml
171
src/Language.ml
|
|
@ -6,13 +6,44 @@ open GT
|
|||
(* Opening a library for combinator-based syntax analysis *)
|
||||
open Ostap
|
||||
open Combinators
|
||||
|
||||
|
||||
(* Values *)
|
||||
module Value =
|
||||
struct
|
||||
|
||||
@type t = Int of int | String of string | Array of t list | Sexp of string * t list with show
|
||||
|
||||
let to_int = function
|
||||
| Int n -> n
|
||||
| _ -> failwith "int value expected"
|
||||
|
||||
let to_string = function
|
||||
| String s -> s
|
||||
| _ -> failwith "string value expected"
|
||||
|
||||
let to_array = function
|
||||
| Array a -> a
|
||||
| _ -> failwith "array value expected"
|
||||
|
||||
let of_int n = Int n
|
||||
let of_string s = String s
|
||||
let of_array a = Array a
|
||||
|
||||
let tag_of = function
|
||||
| Sexp (t, _) -> t
|
||||
| _ -> failwith "symbolic expression expected"
|
||||
|
||||
let update_string s i x = String.init (String.length s) (fun j -> if j = i then x else s.[j])
|
||||
let update_array a i x = List.init (List.length a) (fun j -> if j = i then x else List.nth a j)
|
||||
|
||||
end
|
||||
|
||||
(* States *)
|
||||
module State =
|
||||
struct
|
||||
|
||||
(* State: global state, local state, scope variables *)
|
||||
type t = {g : string -> int; l : string -> int; scope : string list}
|
||||
type t = {g : string -> Value.t; l : string -> Value.t; scope : string list}
|
||||
|
||||
(* Empty state *)
|
||||
let empty =
|
||||
|
|
@ -36,6 +67,27 @@ module State =
|
|||
let leave st st' = {st' with g = st.g}
|
||||
|
||||
end
|
||||
|
||||
(* Builtins *)
|
||||
module Builtin =
|
||||
struct
|
||||
|
||||
let eval (st, i, o, _) args = function
|
||||
| "read" -> (match i with z::i' -> (st, i', o, Some (Value.of_int z)) | _ -> failwith "Unexpected end of input")
|
||||
| "write" -> (st, i, o @ [Value.to_int @@ List.hd args], None)
|
||||
| "$elem" -> let [b; j] = args in
|
||||
(st, i, o, let i = Value.to_int j in
|
||||
Some (match b with
|
||||
| Value.String s -> Value.of_int @@ Char.code s.[i]
|
||||
| Value.Array a -> List.nth a i
|
||||
|
||||
)
|
||||
)
|
||||
| "$length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Array a -> List.length a | Value.String s -> String.length s)))
|
||||
| "$array" -> (st, i, o, Some (Value.of_array args))
|
||||
| s -> failwith (Printf.sprintf "Wow: %s\n" s)
|
||||
|
||||
end
|
||||
|
||||
(* Simple expressions: syntax and semantics *)
|
||||
module Expr =
|
||||
|
|
@ -45,10 +97,15 @@ module Expr =
|
|||
notation, it came from GT.
|
||||
*)
|
||||
@type t =
|
||||
(* integer constant *) | Const of int
|
||||
(* variable *) | Var of string
|
||||
(* binary operator *) | Binop of string * t * t
|
||||
(* function call *) | Call of string * t list with show
|
||||
(* integer constant *) | Const of int
|
||||
(* array *) | Array of t list
|
||||
(* string *) | String of string
|
||||
(* S-expressions *) | Sexp of string * t list
|
||||
(* variable *) | Var of string
|
||||
(* binary operator *) | Binop of string * t * t
|
||||
(* element extraction *) | Elem of t * t
|
||||
(* length *) | Length of t
|
||||
(* function call *) | Call of string * t list with show
|
||||
|
||||
(* Available binary operators:
|
||||
!! --- disjunction
|
||||
|
|
@ -59,7 +116,7 @@ module Expr =
|
|||
*)
|
||||
|
||||
(* The type of configuration: a state, an input stream, an output stream, an optional value *)
|
||||
type config = State.t * int list * int list * int option
|
||||
type config = State.t * int list * int list * Value.t option
|
||||
|
||||
(* Expression evaluator
|
||||
|
||||
|
|
@ -96,17 +153,39 @@ module Expr =
|
|||
|
||||
let rec eval env ((st, i, o, r) as conf) expr =
|
||||
match expr with
|
||||
| Const n -> (st, i, o, Some n)
|
||||
| Var x -> (st, i, o, Some (State.eval st x))
|
||||
| Const n -> (st, i, o, Some (Value.of_int n))
|
||||
| String s -> (st, i, o, Some (Value.of_string s))
|
||||
| Var x -> (st, i, o, Some (State.eval st x))
|
||||
| Array xs ->
|
||||
let (st, i, o, vs) = eval_list env conf xs in
|
||||
env#definition env "$array" vs (st, i, o, None)
|
||||
| Sexp (t, xs) ->
|
||||
let (st, i, o, vs) = eval_list env conf xs in
|
||||
(st, i, o, Some (Value.Sexp (t, vs)))
|
||||
| Binop (op, x, y) ->
|
||||
let (_, _, _, Some x) as conf = eval env conf x in
|
||||
let (st, i, o, Some y) as conf = eval env conf y in
|
||||
(st, i, o, Some (to_func op x y))
|
||||
(st, i, o, Some (Value.of_int @@ to_func op (Value.to_int x) (Value.to_int y)))
|
||||
| Elem (b, i) ->
|
||||
let (st, i, o, args) = eval_list env conf [b; i] in
|
||||
env#definition env "$elem" args (st, i, o, None)
|
||||
| Length e ->
|
||||
let (st, i, o, Some v) = eval env conf e in
|
||||
env#definition env "$length" [v] (st, i, o, None)
|
||||
| Call (f, args) ->
|
||||
let args, conf =
|
||||
List.fold_left (fun (acc, conf) e -> let (_, _, _, Some v) as conf = eval env conf e in v::acc, conf) ([], conf) args
|
||||
in
|
||||
env#definition env f (List.rev args) conf
|
||||
let (st, i, o, args) = eval_list env conf args in
|
||||
env#definition env f args (st, i, o, None)
|
||||
and eval_list env conf xs =
|
||||
let vs, (st, i, o, _) =
|
||||
List.fold_left
|
||||
(fun (acc, conf) x ->
|
||||
let (_, _, _, Some v) as conf = eval env conf x in
|
||||
v::acc, conf
|
||||
)
|
||||
([], conf)
|
||||
xs
|
||||
in
|
||||
(st, i, o, List.rev vs)
|
||||
|
||||
(* Expression parser. You can use the following terminals:
|
||||
|
||||
|
|
@ -129,10 +208,15 @@ module Expr =
|
|||
|]
|
||||
)
|
||||
primary);
|
||||
|
||||
primary:
|
||||
n:DECIMAL {Const n}
|
||||
| x:IDENT s:("(" args:!(Util.list0)[parse] ")" {Call (x, args)} | empty {Var x}) {s}
|
||||
primary: b:base is:(-"[" i:parse -"]" {`Elem i} | "." %"length" {`Len}) *
|
||||
{List.fold_left (fun b -> function `Elem i -> Elem (b, i) | `Len -> Length b) b is};
|
||||
base:
|
||||
n:DECIMAL {Const n}
|
||||
| s:STRING {String (String.sub s 1 (String.length s - 2))}
|
||||
| c:CHAR {Const (Char.code c)}
|
||||
| "[" es:!(Util.list0)[parse] "]" {Array es}
|
||||
| "`" t:IDENT args:(-"(" !(Util.list)[parse] -")")? {Sexp (t, match args with None -> [] | Some args -> args)}
|
||||
| x:IDENT s:("(" args:!(Util.list0)[parse] ")" {Call (x, args)} | empty {Var x}) {s}
|
||||
| -"(" parse -")"
|
||||
)
|
||||
|
||||
|
|
@ -143,17 +227,15 @@ module Stmt =
|
|||
struct
|
||||
|
||||
(* The type for statements *)
|
||||
@type t =
|
||||
(* read into the variable *) | Read of string
|
||||
(* write the value of an expression *) | Write of Expr.t
|
||||
(* assignment *) | Assign of string * Expr.t
|
||||
type t =
|
||||
(* assignment *) | Assign of string * Expr.t list * Expr.t
|
||||
(* composition *) | Seq of t * t
|
||||
(* empty statement *) | Skip
|
||||
(* conditional *) | If of Expr.t * t * t
|
||||
(* loop with a pre-condition *) | While of Expr.t * t
|
||||
(* loop with a post-condition *) | Repeat of t * Expr.t
|
||||
(* return statement *) | Return of Expr.t option
|
||||
(* call a procedure *) | Call of string * Expr.t list with show
|
||||
(* call a procedure *) | Call of string * Expr.t list
|
||||
|
||||
(* Statement evaluator
|
||||
|
||||
|
|
@ -162,17 +244,32 @@ module Stmt =
|
|||
Takes an environment, a configuration and a statement, and returns another configuration. The
|
||||
environment is the same as for expressions
|
||||
*)
|
||||
|
||||
let update st x v is =
|
||||
let rec update a v = function
|
||||
| [] -> v
|
||||
| i::tl ->
|
||||
let i = Value.to_int i in
|
||||
(match a with
|
||||
| Value.String s when tl = [] -> Value.String (Value.update_string s i (Char.chr @@ Value.to_int v))
|
||||
| Value.Array a -> Value.Array (Value.update_array a i (update (List.nth a i) v tl))
|
||||
)
|
||||
in
|
||||
State.update x (match is with [] -> v | _ -> update (State.eval st x) v is) st
|
||||
|
||||
let rec eval env ((st, i, o, r) as conf) k stmt =
|
||||
let seq x = function Skip -> x | y -> Seq (x, y) in
|
||||
match stmt with
|
||||
| Read x -> eval env (match i with z::i' -> (State.update x z st, i', o, r) | _ -> failwith "Unexpected end of input") Skip k
|
||||
| Write e -> eval env (let (st, i, o, Some v) = Expr.eval env conf e in (st, i, o @ [v], r)) Skip k
|
||||
| Assign (x, e) -> eval env (let (st, i, o, Some v) = Expr.eval env conf e in (State.update x v st, i, o, r)) Skip k
|
||||
| Assign (x, is, e) ->
|
||||
let (st, i, o, is) = Expr.eval_list env conf is in
|
||||
let (st, i, o, Some v) = Expr.eval env (st, i, o, None) e in
|
||||
eval env (update st x v is, i, o, None) Skip k
|
||||
|
||||
| Seq (s1, s2) -> eval env conf (seq s2 k) s1
|
||||
| Skip -> (match k with Skip -> conf | _ -> eval env conf Skip k)
|
||||
| If (e, s1, s2) -> let (_, _, _, Some v) as conf = Expr.eval env conf e in eval env conf k (if v <> 0 then s1 else s2)
|
||||
| If (e, s1, s2) -> let (_, _, _, Some v) as conf = Expr.eval env conf e in eval env conf k (if Value.to_int v <> 0 then s1 else s2)
|
||||
| While (e, s) -> let (_, _, _, Some v) as conf = Expr.eval env conf e in
|
||||
if v = 0
|
||||
if Value.to_int v = 0
|
||||
then eval env conf Skip k
|
||||
else eval env conf (seq stmt k) s
|
||||
| Repeat (s, e) -> eval env conf (seq (While (Expr.Binop ("==", e, Expr.Const 0), s)) k) s
|
||||
|
|
@ -185,9 +282,7 @@ module Stmt =
|
|||
s:stmt ";" ss:parse {Seq (s, ss)}
|
||||
| stmt;
|
||||
stmt:
|
||||
%"read" "(" x:IDENT ")" {Read x}
|
||||
| %"write" "(" e:!(Expr.parse) ")" {Write e}
|
||||
| %"skip" {Skip}
|
||||
%"skip" {Skip}
|
||||
| %"if" e:!(Expr.parse)
|
||||
%"then" the:parse
|
||||
elif:(%"elif" !(Expr.parse) %"then" parse)*
|
||||
|
|
@ -207,7 +302,7 @@ module Stmt =
|
|||
| %"repeat" s:parse %"until" e:!(Expr.parse) {Repeat (s, e)}
|
||||
| %"return" e:!(Expr.parse)? {Return e}
|
||||
| x:IDENT
|
||||
s:(":=" e :!(Expr.parse) {Assign (x, e)} |
|
||||
s:(is:(-"[" !(Expr.parse) -"]")* ":=" e :!(Expr.parse) {Assign (x, is, e)} |
|
||||
"(" args:!(Util.list0)[Expr.parse] ")" {Call (x, args)}
|
||||
) {s}
|
||||
)
|
||||
|
|
@ -249,11 +344,13 @@ let eval (defs, body) i =
|
|||
let _, _, o, _ =
|
||||
Stmt.eval
|
||||
(object
|
||||
method definition env f args (st, i, o, r) =
|
||||
let xs, locs, s = snd @@ M.find f m in
|
||||
let st' = List.fold_left (fun st (x, a) -> State.update x a st) (State.enter st (xs @ locs)) (List.combine xs args) in
|
||||
let st'', i', o', r' = Stmt.eval env (st', i, o, r) Skip s in
|
||||
(State.leave st'' st, i', o', r')
|
||||
method definition env f args ((st, i, o, r) as conf) =
|
||||
try
|
||||
let xs, locs, s = snd @@ M.find f m in
|
||||
let st' = List.fold_left (fun st (x, a) -> State.update x a st) (State.enter st (xs @ locs)) (List.combine xs args) in
|
||||
let st'', i', o', r' = Stmt.eval env (st', i, o, r) Skip s in
|
||||
(State.leave st'' st, i', o', r')
|
||||
with Not_found -> Builtin.eval conf args f
|
||||
end)
|
||||
(State.empty, i, [], None)
|
||||
Skip
|
||||
|
|
|
|||
111
src/SM.ml
111
src/SM.ml
|
|
@ -3,29 +3,32 @@ open Language
|
|||
|
||||
(* The type for the stack machine instructions *)
|
||||
@type insn =
|
||||
(* binary operator *) | BINOP of string
|
||||
(* put a constant on the stack *) | CONST of int
|
||||
(* binary operator *) | BINOP of string
|
||||
(* put a constant on the stack *) | CONST of int
|
||||
(* put a string on the stack *) | STRING of string
|
||||
(* read to stack *) | READ
|
||||
(* write from stack *) | WRITE
|
||||
(* load a variable to the stack *) | LD of string
|
||||
(* store a variable from the stack *) | ST of string
|
||||
(* a label *) | LABEL of string
|
||||
(* unconditional jump *) | JMP of string
|
||||
(* conditional jump *) | CJMP of string * string
|
||||
(* begins procedure definition *) | BEGIN of string * string list * string list
|
||||
(* load a variable to the stack *) | LD of string
|
||||
(* store a variable from the stack *) | ST of string
|
||||
(* store in an array *) | STA of string * int
|
||||
(* a label *) | LABEL of string
|
||||
(* unconditional jump *) | JMP of string
|
||||
(* conditional jump *) | CJMP of string * string
|
||||
(* begins procedure definition *) | BEGIN of string * string list * string list
|
||||
(* end procedure definition *) | END
|
||||
(* calls a function/procedure *) | CALL of string * int * bool
|
||||
(* returns from a function *) | RET of bool with show
|
||||
(* calls a function/procedure *) | CALL of string * int * bool
|
||||
(* returns from a function *) | RET of bool with show
|
||||
|
||||
(* The type for the stack machine program *)
|
||||
(* The type for the stack machine program *)
|
||||
|
||||
type prg = insn list
|
||||
|
||||
let print_prg p = List.iter (fun i -> Printf.printf "%s\n" (show(insn) i)) p
|
||||
|
||||
(* The type for the stack machine configuration: control stack, stack and configuration from statement
|
||||
interpreter
|
||||
*)
|
||||
type config = (prg * State.t) list * int list * Expr.config
|
||||
*)
|
||||
type config = (prg * State.t) list * Value.t list * Expr.config
|
||||
|
||||
(* Stack machine interpreter
|
||||
|
||||
|
|
@ -34,31 +37,37 @@ type config = (prg * State.t) list * int list * Expr.config
|
|||
Takes an environment, a configuration and a program, and returns a configuration as a result. The
|
||||
environment is used to locate a label to jump to (via method env#labeled <label_name>)
|
||||
*)
|
||||
let split n l =
|
||||
let rec unzip (taken, rest) = function
|
||||
| 0 -> (List.rev taken, rest)
|
||||
| n -> let h::tl = rest in unzip (h::taken, tl) (n-1)
|
||||
in
|
||||
unzip ([], l) n
|
||||
|
||||
let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
|
||||
| [] -> conf
|
||||
| insn :: prg' ->
|
||||
(match insn with
|
||||
| BINOP op -> let y::x::stack' = stack in eval env (cstack, Expr.to_func op x y :: stack', c) prg'
|
||||
| READ -> let z::i' = i in eval env (cstack, z::stack, (st, i', o)) prg'
|
||||
| WRITE -> let z::stack' = stack in eval env (cstack, stack', (st, i, o @ [z])) prg'
|
||||
| CONST i -> eval env (cstack, i::stack, c) prg'
|
||||
| LD x -> eval env (cstack, State.eval st x :: stack, c) prg'
|
||||
| ST x -> let z::stack' = stack in eval env (cstack, stack', (State.update x z st, i, o)) prg'
|
||||
| LABEL _ -> eval env conf prg'
|
||||
| JMP l -> eval env conf (env#labeled l)
|
||||
| CJMP (c, l) -> let x::stack' = stack in eval env (cstack, stack', (st, i, o)) (if (c = "z" && x = 0) || (c = "nz" && x <> 0) then env#labeled l else prg')
|
||||
| CALL (f, _, _) -> eval env ((prg', st)::cstack, stack, c) (env#labeled f)
|
||||
| BEGIN (_, args, locals) -> let rec combine acc args stack =
|
||||
match args, stack with
|
||||
| [], _ -> List.rev acc, stack
|
||||
| a::args', s::stack' -> combine ((a, s)::acc) args' stack'
|
||||
in
|
||||
let state', stack' = combine [] args stack in
|
||||
eval env (cstack, stack', (List.fold_left (fun s (x, v) -> State.update x v s) (State.enter st (args @ locals)) state', i, o)) prg'
|
||||
| END | RET _ -> (match cstack with
|
||||
| (prg', st')::cstack' -> eval env (cstack', stack, (State.leave st st', i, o)) prg'
|
||||
| [] -> conf
|
||||
)
|
||||
| BINOP op -> let y::x::stack' = stack in eval env (cstack, (Value.of_int @@ Expr.to_func op (Value.to_int x) (Value.to_int y)) :: stack', c) prg'
|
||||
| CONST i -> eval env (cstack, (Value.of_int i)::stack, c) prg'
|
||||
| STRING s -> eval env (cstack, (Value.of_string s)::stack, c) prg'
|
||||
| LD x -> eval env (cstack, State.eval st x :: stack, c) prg'
|
||||
| ST x -> let z::stack' = stack in eval env (cstack, stack', (State.update x z st, i, o)) prg'
|
||||
| STA (x, n) -> let v::is, stack' = split (n+1) stack in
|
||||
eval env (cstack, stack', (Language.Stmt.update st x v (List.rev is), i, o)) prg'
|
||||
| LABEL _ -> eval env conf prg'
|
||||
| JMP l -> eval env conf (env#labeled l)
|
||||
| CJMP (c, l) -> let x::stack' = stack in eval env (cstack, stack', (st, i, o)) (if (c = "z" && Value.to_int x = 0) || (c = "nz" && Value.to_int x <> 0) then env#labeled l else prg')
|
||||
| CALL (f, n, p) -> if env#is_label f
|
||||
then eval env ((prg', st)::cstack, stack, c) (env#labeled f)
|
||||
else eval env (env#builtin conf f n p) prg'
|
||||
| BEGIN (_, args, locals) -> let vs, stack' = split (List.length args) stack in
|
||||
let state = List.combine args vs in
|
||||
eval env (cstack, stack', (List.fold_left (fun s (x, v) -> State.update x v s) (State.enter st (args @ locals)) state, i, o)) prg'
|
||||
| END | RET _ -> (match cstack with
|
||||
| (prg', st')::cstack' -> eval env (cstack', stack, (State.leave st st', i, o)) prg'
|
||||
| [] -> conf
|
||||
)
|
||||
)
|
||||
|
||||
(* Top-level evaluation
|
||||
|
|
@ -68,7 +77,7 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
|
|||
Takes a program, an input stream, and returns an output stream this program calculates
|
||||
*)
|
||||
let run p i =
|
||||
(*print_prg p;*)
|
||||
(* print_prg p; *)
|
||||
let module M = Map.Make (String) in
|
||||
let rec make_map m = function
|
||||
| [] -> m
|
||||
|
|
@ -76,7 +85,24 @@ let run p i =
|
|||
| _ :: tl -> make_map m tl
|
||||
in
|
||||
let m = make_map M.empty p in
|
||||
let (_, _, (_, _, o)) = eval (object method labeled l = M.find l m end) ([], [], (State.empty, i, [])) p in o
|
||||
let (_, _, (_, _, o)) =
|
||||
eval
|
||||
(object
|
||||
method is_label l = M.mem l m
|
||||
method labeled l = M.find l m
|
||||
method builtin (cstack, stack, (st, i, o)) f n p =
|
||||
let f = match f.[0] with 'L' -> String.sub f 1 (String.length f - 1) | _ -> f in
|
||||
let args, stack' = split n stack in
|
||||
let (st, i, o, r) = Language.Builtin.eval (st, i, o, None) args f in
|
||||
let stack'' = if p then stack' else let Some r = r in r::stack' in
|
||||
Printf.printf "Builtin: %s\n";
|
||||
(cstack, stack'', (st, i, o))
|
||||
end
|
||||
)
|
||||
([], [], (State.empty, i, []))
|
||||
p
|
||||
in
|
||||
o
|
||||
|
||||
(* Stack machine compiler
|
||||
|
||||
|
|
@ -91,15 +117,18 @@ let compile (defs, p) =
|
|||
let args_code = List.concat @@ List.map expr (List.rev args) in
|
||||
args_code @ [CALL (label f, List.length args, p)]
|
||||
and expr = function
|
||||
| Expr.Var x -> [LD x]
|
||||
| Expr.Const n -> [CONST n]
|
||||
| Expr.Var x -> [LD x]
|
||||
| Expr.Const n -> [CONST n]
|
||||
| Expr.String s -> [STRING s]
|
||||
| Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
|
||||
| Expr.Call (f, args) -> call f args false
|
||||
| Expr.Array xs -> List.flatten (List.map expr xs) @ [CALL ("$array", List.length xs, false)]
|
||||
| Expr.Elem (a, i) -> expr i @ expr a @ [CALL ("$elem", 2, false)]
|
||||
| Expr.Length e -> expr e @ [CALL ("$length", 1, false)]
|
||||
in
|
||||
let rec compile_stmt l env = function
|
||||
| Stmt.Read x -> env, false, [READ; ST x]
|
||||
| Stmt.Write e -> env, false, expr e @ [WRITE]
|
||||
| Stmt.Assign (x, e) -> env, false, expr e @ [ST x]
|
||||
| Stmt.Assign (x, [], e) -> env, false, expr e @ [ST x]
|
||||
| Stmt.Assign (x, is, e) -> env, false, List.flatten (List.map expr (is @ [e])) @ [STA (x, List.length is)]
|
||||
| Stmt.Skip -> env, false, []
|
||||
|
||||
| Stmt.Seq (s1, s2) -> let l2, env = env#get_label in
|
||||
|
|
|
|||
15
src/X86.ml
15
src/X86.ml
|
|
@ -107,22 +107,17 @@ let compile env code =
|
|||
| instr :: scode' ->
|
||||
let env', code' =
|
||||
match instr with
|
||||
| READ ->
|
||||
let s, env' = env#allocate in
|
||||
(env', [Call "Lread"; Mov (eax, s)])
|
||||
| WRITE ->
|
||||
let s, env' = env#pop in
|
||||
(env', [Push s; Call "Lwrite"; Pop eax])
|
||||
| CONST n ->
|
||||
let s, env' = env#allocate in
|
||||
(env', [Mov (L n, s)])
|
||||
(env', [Mov (L n, s)])
|
||||
| LD x ->
|
||||
let s, env' = (env#global x)#allocate in
|
||||
env',
|
||||
(match s with
|
||||
| S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
|
||||
| _ -> [Mov (env'#loc x, s)]
|
||||
)
|
||||
)
|
||||
| STA (x, n) -> failwith ""
|
||||
| ST x ->
|
||||
let s, env' = (env#global x)#pop in
|
||||
env',
|
||||
|
|
@ -260,7 +255,7 @@ class env =
|
|||
let x, n =
|
||||
let rec allocate' = function
|
||||
| [] -> ebx , 0
|
||||
| (S n)::_ -> S (n+1) , n+1
|
||||
| (S n)::_ -> S (n+1) , n+2
|
||||
| (R n)::_ when n < num_of_regs -> R (n+1) , stack_slots
|
||||
| (M _)::s -> allocate' s
|
||||
| _ -> S 0 , 1
|
||||
|
|
@ -300,7 +295,7 @@ class env =
|
|||
(* returns a list of live registers *)
|
||||
method live_registers =
|
||||
List.filter (function R _ -> true | _ -> false) stack
|
||||
|
||||
|
||||
end
|
||||
|
||||
(* Generates an assembler text for a program: first compiles the program into
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue