diff --git a/expr_grammar_action.g b/expr_grammar_action.g
index b8715788a735dc6305cdbe0404771acc8d6d22f5..8eb98dda3e5410d40e0df22fb2c57d2f2973dd05 100644
--- a/expr_grammar_action.g
+++ b/expr_grammar_action.g
@@ -1,7 +1,9 @@
tokens SYM_EOF SYM_IDENTIFIER<string> SYM_INTEGER<int> SYM_PLUS SYM_MINUS SYM_ASTERISK SYM_DIV SYM_MOD
tokens SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE
-tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA SYM_PRINT
+tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA
tokens SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ
+tokens SYM_INT SYM_CHAR SYM_VOID SYM_CHARACTER<char>
+tokens SYM_AMPERSAND
non-terminals S INSTR<tree> INSTRS<tree list> LINSTRS ELSE EXPR FACTOR
non-terminals LPARAMS REST_PARAMS
non-terminals IDENTIFIER INTEGER
@@ -11,7 +13,9 @@ non-terminals MUL_EXPRS MUL_EXPR
non-terminals CMP_EXPRS CMP_EXPR
non-terminals EQ_EXPRS EQ_EXPR
-non-terminals AFTER_IDENTIFIER LARGS REST_ARGS
+non-terminals AFTER_IDENTIFIER_INSTR AFTER_IDENTIFIER_FACTOR LARGS REST_ARGS
+non-terminals TYPE AFTER_IDENTIFIER_DEC CHARACTER FUN_INSTR
+non-terminals ASTERIKS MEM_OPS
axiom S
{
@@ -22,6 +26,7 @@ axiom S
open BatBuffer
open Batteries
open Utils
+ open Prog
type after_id =
| Assign of tree
@@ -34,24 +39,42 @@ axiom S
match List.rev other with
| [] -> term
| (high_tag, right_side)::rest -> Node(high_tag, [resolve_associativity term (List.rev rest); right_side])
+
+ let rec make_type_ast (l : string list) : typ =
+ match List.rev l with
+ | ["int"] -> Tint
+ | ["char"] -> Tchar
+ | ["void"] -> Tvoid
+ | "*"::rest -> Tptr (make_type_ast (List.rev rest))
+ | _ -> Tvoid
}
rules
S -> FUNDEFS SYM_EOF { Node(Tlistglobdef, $1) }
FUNDEFS -> FUNDEF FUNDEFS { $1::$2 }
FUNDEFS -> { [] }
-FUNDEF -> IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS INSTR { Node(Tfundef, [Node(Tfunname, [$1]); Node(Tfunargs, $3); Node(Tfunbody, [$5])]) }
+FUNDEF -> TYPE IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS FUN_INSTR { Node(Tfundef, [Node(Tfuntype, [$1]); Node(Tfunname, [$2]); Node(Tfunargs, $4); Node(Tfunbody, [$6])]) }
-LPARAMS -> IDENTIFIER REST_PARAMS { Node(Targ, [$1])::$2 }
+TYPE -> SYM_INT ASTERIKS { TypeLeaf (make_type_ast ("int"::$2)) }
+TYPE -> SYM_CHAR ASTERIKS { TypeLeaf (make_type_ast ("char"::$2)) }
+TYPE -> SYM_VOID ASTERIKS { TypeLeaf (make_type_ast ("void"::$2)) }
+
+ASTERIKS -> SYM_ASTERISK ASTERIKS { "*"::$2 }
+ASTERIKS -> { [] }
+
+LPARAMS -> TYPE IDENTIFIER REST_PARAMS { Node(Targ, [$1; $2])::$3 }
LPARAMS -> { [] }
-REST_PARAMS -> SYM_COMMA LPARAMS { $2 }
+REST_PARAMS -> SYM_COMMA TYPE IDENTIFIER REST_PARAMS { Node(Targ, [$2; $3])::$4 }
REST_PARAMS -> { [] }
LARGS -> EXPR REST_ARGS { $1::$2 }
LARGS -> { [] }
-REST_ARGS -> SYM_COMMA LARGS { $2 }
+REST_ARGS -> SYM_COMMA EXPR REST_ARGS { $2::$3 }
REST_ARGS -> { [] }
+FUN_INSTR -> SYM_LBRACE LINSTRS SYM_RBRACE { $2 }
+FUN_INSTR -> SYM_SEMICOLON { NullLeaf }
+
LINSTRS -> INSTR INSTRS { Node(Tblock, $1::$2) }
LINSTRS -> { NullLeaf }
INSTRS -> INSTR INSTRS { $1::$2 }
@@ -60,18 +83,25 @@ INSTRS -> { [] }
INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_LBRACE LINSTRS SYM_RBRACE ELSE { Node(Tif, [$3; $6; $8]) }
INSTR -> SYM_WHILE SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS INSTR { Node(Twhile, [$3; $5]) }
INSTR -> SYM_RETURN EXPR SYM_SEMICOLON { Node(Treturn, [$2]) }
-INSTR -> SYM_PRINT SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_SEMICOLON { Node(Tprint, [$3]) }
-INSTR -> IDENTIFIER AFTER_IDENTIFIER SYM_SEMICOLON {
- match $2 with
- | Assign exp -> Node(Tassign, [$1; exp])
- | Funcall args -> Node(Tcall, [$1; Node(Targs, args)])
- | _ -> $1
+INSTR -> MEM_OPS IDENTIFIER AFTER_IDENTIFIER_INSTR SYM_SEMICOLON {
+ match $3 with
+ | Assign exp -> Node(Tassign, [Node(Tmem, [MemopsLeaf $1; $2]); exp])
+ | Funcall args -> Node(Tmem, [MemopsLeaf $1; Node(Tcall, [$2; Node(Targs, args)])])
+ | _ -> $2
+}
+INSTR -> TYPE IDENTIFIER AFTER_IDENTIFIER_DEC SYM_SEMICOLON {
+ match $3 with
+ | Assign exp -> Node(Tblock, [Node(Tdeclare, [$1; $2]); Node(Tassign, [$2; exp])])
+ | Nothing -> Node(Tdeclare, [$1; $2])
+ | _ -> $2
}
INSTR -> SYM_LBRACE LINSTRS SYM_RBRACE { $2 }
-AFTER_IDENTIFIER -> SYM_ASSIGN EXPR { Assign $2 }
-AFTER_IDENTIFIER -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 }
-AFTER_IDENTIFIER -> { Nothing }
+AFTER_IDENTIFIER_INSTR -> SYM_ASSIGN EXPR { Assign $2 }
+AFTER_IDENTIFIER_INSTR -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 }
+
+AFTER_IDENTIFIER_DEC -> SYM_ASSIGN EXPR { Assign $2 }
+AFTER_IDENTIFIER_DEC -> { Nothing }
ELSE -> SYM_ELSE SYM_LBRACE LINSTRS SYM_RBRACE { $3 }
ELSE -> { NullLeaf }
@@ -104,13 +134,22 @@ MUL_EXPRS -> SYM_MOD MUL_EXPR MUL_EXPRS { (Tmod, $2)::$3 }
MUL_EXPRS -> { [] }
FACTOR -> INTEGER { $1 }
-FACTOR -> IDENTIFIER AFTER_IDENTIFIER {
- match $2 with
- | Funcall args -> Node(Tcall, [$1; Node(Targs, args)])
- | Nothing -> $1
- | _ -> $1
+FACTOR -> MEM_OPS IDENTIFIER AFTER_IDENTIFIER_FACTOR {
+ match $3 with
+ | Funcall args -> Node(Tmem, [MemopsLeaf $1; Node(Tcall, [$2; Node(Targs, args)])])
+ | Nothing -> Node(Tmem, [MemopsLeaf $1; $2])
+ | _ -> Node(Tmem, [MemopsLeaf $1; $2])
}
FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS { $2 }
+FACTOR -> CHARACTER { $1 }
-IDENTIFIER -> SYM_IDENTIFIER {StringLeaf $1}
+IDENTIFIER -> SYM_IDENTIFIER { StringLeaf $1 }
INTEGER -> SYM_INTEGER {IntLeaf $1}
+CHARACTER -> SYM_CHARACTER {CharLeaf $1}
+
+MEM_OPS -> SYM_AMPERSAND MEM_OPS { Ampersand::$2 }
+MEM_OPS -> SYM_ASTERISK MEM_OPS { Asterik::$2 }
+MEM_OPS -> { [] }
+
+AFTER_IDENTIFIER_FACTOR -> { Nothing }
+AFTER_IDENTIFIER_FACTOR -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 }
diff --git a/src/ast.ml b/src/ast.ml
index cfb67d68813386c3ef6d396f5c9edec01f3753bc..c366d589f8622e7f87a8e473108748718448e4bb 100644
--- a/src/ast.ml
+++ b/src/ast.ml
@@ -1,4 +1,5 @@
open Batteries
+open Prog
(* Les AST sont des arbres, du type [tree], étiquetés par des [tag].
@@ -22,26 +23,34 @@ open Batteries
*)
-type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint
- | Tint
+type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tdeclare
| Tadd | Tmul | Tdiv | Tmod | Txor | Tsub
| Tclt | Tcgt | Tcle | Tcge | Tceq | Tne
| Tneg
| Tlistglobdef
- | Tfundef | Tfunname | Tfunargs | Tfunbody | Tcall
- | Tassignvar
+ | Tfundef | Tfuntype | Tfunname | Tfunargs | Tfunbody | Tcall
+ | Tassignvar (*never used*)
| Targ | Targs
+ | Tmem
+
+type mem_op = | Asterik
+ | Ampersand
type tree = | Node of tag * tree list
| StringLeaf of string
| IntLeaf of int
| NullLeaf
| CharLeaf of char
-
+ | TypeLeaf of typ
+ | MemopsLeaf of mem_op list
let string_of_stringleaf = function
| StringLeaf s -> s
| _ -> failwith "string_of_stringleaf called on non-stringleaf nodes."
+let string_of_memop = function
+ | Asterik -> "*"
+ | Ampersand -> "&"
+
type astfun = (string list * tree)
type ast = (string * astfun) list
@@ -51,8 +60,6 @@ let string_of_tag = function
| Twhile -> "Twhile"
| Tblock -> "Tblock"
| Treturn -> "Treturn"
- | Tprint -> "Tprint"
- | Tint -> "Tint"
| Tadd -> "Tadd"
| Tmul -> "Tmul"
| Tdiv -> "Tdiv"
@@ -75,6 +82,9 @@ let string_of_tag = function
| Targ -> "Targ"
| Tcall -> "Tcall"
| Targs -> "Targs"
+ | Tdeclare -> "Tdeclare"
+ | Tfuntype -> "Tfuntype"
+ | Tmem -> "Tmem"
(* Écrit un fichier .dot qui correspond à un AST *)
let rec draw_ast a next =
@@ -92,7 +102,6 @@ let rec draw_ast a next =
] @ List.map (fun n ->
Format.sprintf "n%d -> n%d\n" next n
)nodes)
-
| StringLeaf s ->
(next, next+1, [ Format.sprintf "n%d [label=\"%s\"]\n" next s])
| IntLeaf i ->
@@ -101,6 +110,10 @@ let rec draw_ast a next =
(next, next+1, [ Format.sprintf "n%d [label=\"null\"]\n" next])
| CharLeaf i ->
(next, next+1, [ Format.sprintf "n%d [label=\"%c\"]\n" next i])
+ | TypeLeaf t ->
+ (next, next+1, [ Format.sprintf "n%d [label=\"%s\"]\n" next (string_of_typ t)])
+ | MemopsLeaf memops ->
+ (next, next+1, [ Format.sprintf "n%d [label=\"%s\"]\n" next (String.concat "" (List.map string_of_memop memops))])
let draw_ast_tree oc ast =
let (_, _, s) = draw_ast ast 1 in
@@ -116,3 +129,5 @@ let rec string_of_ast a =
| IntLeaf i -> Format.sprintf "%d" i
| CharLeaf i -> Format.sprintf "%c" i
| NullLeaf -> "null"
+ | TypeLeaf t -> string_of_typ t
+ | MemopsLeaf memops -> String.concat "" (List.map string_of_memop memops)
\ No newline at end of file
diff --git a/src/cfg.ml b/src/cfg.ml
index 2a60c97dde93858dca8cb0acd4d788686e407ad4..467b19b8effc117ec88e216c87a5774c28d6eff2 100644
--- a/src/cfg.ml
+++ b/src/cfg.ml
@@ -13,7 +13,6 @@ type expr =
type cfg_node =
| Cassign of string * expr * int
| Creturn of expr
- | Cprint of expr * int
| Ccmp of expr * int * int
| Cnop of int
| Ccall of string * expr list * int
@@ -32,7 +31,6 @@ type cprog = cfg_fun prog
let succs cfg n =
match Hashtbl.find_option cfg n with
| None -> Set.empty
- | Some (Cprint (_, s))
| Some (Cassign (_, _, s)) -> Set.singleton s
| Some (Creturn _) -> Set.empty
| Some (Ccmp (_, s1, s2)) -> Set.of_list [s1;s2]
@@ -45,7 +43,6 @@ let preds cfgfunbody n =
Hashtbl.fold (fun m m' acc ->
match m' with
| Cassign (_, _, s)
- | Cprint (_, s)
| Cnop s
| Ccall (_, _, s) -> if s = n then Set.add m acc else acc
| Creturn _ -> acc
@@ -71,7 +68,6 @@ let size_instr (i: cfg_node) : int =
match (i : cfg_node) with
| Cassign (_, e, _) -> 1 + size_expr e
| Creturn e -> 1 + (size_expr e)
- | Cprint (e, _) -> 1 + (size_expr e)
| Ccmp (e, _, _) -> 1 + size_expr e
| Cnop _ -> 1
| Ccall (_, args, _) -> 1 + List.fold_left (fun acc arg -> acc + size_expr arg) 0 args
diff --git a/src/cfg_gen.ml b/src/cfg_gen.ml
index ff2aa1b40a58fd120993c33ea76d81ad62566d50..f347f9843e8160ab01f834a9d93628d8685c3212 100644
--- a/src/cfg_gen.ml
+++ b/src/cfg_gen.ml
@@ -28,6 +28,7 @@ let rec cfg_expr_of_eexpr (e: Elang.expr) : expr res =
| Elang.Ecall (f, args) ->
list_map_res cfg_expr_of_eexpr args >>= fun es ->
OK (Ecall (f, es))
+ | Elang.Echar c -> OK (Eint (Char.code c))
(* [cfg_node_of_einstr next cfg succ i] builds the CFG node(s) that correspond
to the E instruction [i].
@@ -69,15 +70,13 @@ let rec cfg_node_of_einstr (next: int) (cfg : (int, cfg_node) Hashtbl.t)
| Elang.Ireturn e ->
cfg_expr_of_eexpr e >>= fun e ->
Hashtbl.replace cfg next (Creturn e); OK (next, next + 1)
- | Elang.Iprint e ->
- cfg_expr_of_eexpr e >>= fun e ->
- Hashtbl.replace cfg next (Cprint (e,succ));
- OK (next, next + 1)
| Elang.Icall (f, args) ->
list_map_res cfg_expr_of_eexpr args >>= fun es ->
Hashtbl.replace cfg next (Ccall (f, es, succ));
OK (next, next + 1)
-
+ | Elang.Ideclare (_, _) ->
+ Hashtbl.replace cfg next (Cnop succ);
+ OK (next, next + 1)
(* Some nodes may be unreachable after the CFG is entirely generated. The
[reachable_nodes n cfg] constructs the set of node identifiers that are
@@ -89,7 +88,6 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) =
match Hashtbl.find_option cfg n with
| None -> reach
| Some (Cnop succ)
- | Some (Cprint (_, succ))
| Some (Cassign (_, _, succ)) -> reachable_aux succ reach
| Some (Creturn _) -> reach
| Some (Ccmp (_, s1, s2)) ->
@@ -105,7 +103,7 @@ let cfg_fun_of_efun { funargs; funbody } =
(* remove unreachable nodes *)
let r = reachable_nodes node cfg in
Hashtbl.filteri_inplace (fun k _ -> Set.mem k r) cfg;
- OK { cfgfunargs = funargs;
+ OK { cfgfunargs = List.map (fun (s, t) -> s) funargs;
cfgfunbody = cfg;
cfgentry = node;
}
diff --git a/src/cfg_liveness.ml b/src/cfg_liveness.ml
index aa402063e865558f9d0cbc79c32717de5f4e4789..0ecbbc34d329f097c1b884d5756f840c583a1354 100644
--- a/src/cfg_liveness.ml
+++ b/src/cfg_liveness.ml
@@ -32,7 +32,6 @@ let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
match node with
| Cassign (s, e, i) -> vars_in_expr e
| Creturn e -> vars_in_expr e
- | Cprint (e, i) -> vars_in_expr e
| Ccmp (e, i1, i2) -> vars_in_expr e
| Cnop (i) -> Set.empty
| Ccall (f, args, i) -> vars_in_expr (Ecall (f, args))
diff --git a/src/cfg_nop_elim.ml b/src/cfg_nop_elim.ml
index dba2b517d3bd5a6eae86084e13ba3f83bfa0f2e2..4592c82806b38f96203a40847e384d208bf65f5c 100644
--- a/src/cfg_nop_elim.ml
+++ b/src/cfg_nop_elim.ml
@@ -64,7 +64,6 @@ let replace_succs nop_succs (n: cfg_node) =
(* TODO *)
match n with
| Cassign (s, e, i) -> Cassign (s, e, replace_succ nop_succs i)
- | Cprint (e, i) -> Cprint (e, replace_succ nop_succs i)
| Ccmp (e, i1, i2) -> Ccmp (e, replace_succ nop_succs i1, replace_succ nop_succs i2)
| Cnop i -> Cnop (replace_succ nop_succs i)
| Creturn e -> Creturn e
diff --git a/src/cfg_print.ml b/src/cfg_print.ml
index a4524107bb648e3821eb41279a3878c7d92e1212..d7bc9888ff0be42ae9d5f7b20a1aac3f517ad116 100644
--- a/src/cfg_print.ml
+++ b/src/cfg_print.ml
@@ -17,7 +17,6 @@ let dump_list_cfgexpr l =
let dump_arrows oc fname n (node: cfg_node) =
match node with
| Cassign (_, _, succ)
- | Cprint (_, succ)
| Cnop succ
| Ccall (_, _, succ) ->
Format.fprintf oc "n_%s_%d -> n_%s_%d\n" fname n fname succ
@@ -30,7 +29,6 @@ let dump_arrows oc fname n (node: cfg_node) =
let dump_cfg_node oc (node: cfg_node) =
match node with
| Cassign (v, e, _) -> Format.fprintf oc "%s = %s" v (dump_cfgexpr e)
- | Cprint (e, _) -> Format.fprintf oc "print %s" (dump_cfgexpr e)
| Creturn e -> Format.fprintf oc "return %s" (dump_cfgexpr e)
| Ccmp (e, _, _) -> Format.fprintf oc "%s" (dump_cfgexpr e)
| Cnop _ -> Format.fprintf oc "nop"
diff --git a/src/cfg_run.ml b/src/cfg_run.ml
index e2e421204f922d190bce803195f29afe19b47f36..138c34a4ffbf2dc0c6a2cff5334216153ff8abc4 100644
--- a/src/cfg_run.ml
+++ b/src/cfg_run.ml
@@ -34,12 +34,18 @@ let rec eval_cfgexpr oc st cp (e: expr) : (int * int state) res =
| Error msg -> Error msg
| OK (i, st'') -> OK ((l@[i]), st'')
) (OK([], st)) args >>= fun (int_args, st') ->
- find_function cp f >>= fun found_f ->
- match eval_cfgfun oc st' cp f found_f int_args with
- | Error msg -> Error msg
- | OK (None, st'') -> Error (Format.sprintf "CFG: Function %s doesn't have a return value.\n" f)
- | OK (Some ret, st'') -> OK (ret, st'')
-
+ match find_function cp f with
+ | OK found_f ->
+ (match eval_cfgfun oc st' cp f found_f int_args with
+ | Error msg -> Error msg
+ | OK (None, st'') -> Error (Format.sprintf "Function %s doesn't have a return value.\n" f)
+ | OK (Some ret, st'') -> OK (ret, st''))
+ | Error msg ->
+ (match do_builtin oc st.mem f int_args with
+ | Error msg -> Error msg
+ | OK None -> Error (Format.sprintf "Function %s doesn't have a return value.\n" f)
+ | OK (Some ret) -> OK (ret, st'))
+
and eval_cfginstr oc st cp ht (n: int): (int * int state) res =
match Hashtbl.find_option ht n with
| None -> Error (Printf.sprintf "Invalid node identifier\n")
@@ -57,10 +63,6 @@ and eval_cfginstr oc st cp ht (n: int): (int * int state) res =
| Creturn(e) ->
eval_cfgexpr oc st cp e >>= fun (e, st') ->
OK (e, st')
- | Cprint(e, succ) ->
- eval_cfgexpr oc st cp e >>= fun (e, st') ->
- Format.fprintf oc "%d\n" e;
- eval_cfginstr oc st' cp ht succ
| Ccall (f, args, succ) ->
List.fold_left (
fun (acc : (int list * int state) res) (arg : expr) ->
@@ -72,9 +74,16 @@ and eval_cfginstr oc st cp ht (n: int): (int * int state) res =
| OK (i, st'') -> OK ((l@[i]), st'')
) (OK([], st)) args
>>= fun (int_args, st') ->
- find_function cp f >>= fun found_f ->
- eval_cfgfun oc st' cp f found_f int_args >>= fun (ret, st'') ->
- eval_cfginstr oc st'' cp ht succ
+ match find_function cp f with
+ | OK found_f ->
+ (match eval_cfgfun oc st' cp f found_f int_args with
+ | Error msg -> Error msg
+ | OK (_, st'') -> eval_cfginstr oc st'' cp ht succ)
+ | Error msg ->
+ (match do_builtin oc st'.mem f int_args with
+ | OK _ -> eval_cfginstr oc st' cp ht succ
+ | Error msg -> Error msg )
+
and eval_cfgfun oc st cp cfgfunname { cfgfunargs;
cfgfunbody;
diff --git a/src/e_regexp.ml b/src/e_regexp.ml
index a87413d6fb052bca56730881cba0e5c388752812..62c5c8fcb1c7854d2eb659d78ddc2d52254c5ef0 100644
--- a/src/e_regexp.ml
+++ b/src/e_regexp.ml
@@ -70,11 +70,10 @@ let list_regexp : (regexp * (string -> token option)) list =
(keyword_regexp "int", fun _ -> Some (SYM_INT));
(* begin TODO *)
(keyword_regexp "void", fun _ -> Some (SYM_VOID));
- (keyword_regexp "void", fun _ -> Some (SYM_CHAR));
+ (keyword_regexp "char", fun _ -> Some (SYM_CHAR));
(keyword_regexp "if", fun _ -> Some (SYM_IF));
(keyword_regexp "else", fun _ -> Some (SYM_ELSE));
(keyword_regexp "return", fun _ -> Some (SYM_RETURN));
- (keyword_regexp "print", fun _ -> Some (SYM_PRINT));
(keyword_regexp "struct", fun _ -> Some (SYM_STRUCT));
(char_regexp '.', fun _ -> Some (SYM_POINT));
(char_regexp '+', fun _ -> Some (SYM_PLUS));
@@ -91,6 +90,7 @@ let list_regexp : (regexp * (string -> token option)) list =
(char_regexp ';', fun _ -> Some (SYM_SEMICOLON));
(char_regexp ',', fun _ -> Some (SYM_COMMA));
(char_regexp '=', fun _ -> Some (SYM_ASSIGN));
+ (char_regexp '&', fun _ -> Some (SYM_AMPERSAND));
(Cat(char_regexp '=', char_regexp '='), fun _ -> Some (SYM_EQUALITY));
(Cat(char_regexp '!', char_regexp '='), fun _ -> Some (SYM_NOTEQ));
(char_regexp '<', fun _ -> Some (SYM_LT));
diff --git a/src/elang.ml b/src/elang.ml
index 38b4f66064e4cedae6f4f8478ce1cae41b379c9a..f28fc573735eecfbb8b92aab8b8d97c682a4c38c 100644
--- a/src/elang.ml
+++ b/src/elang.ml
@@ -10,6 +10,9 @@ type expr =
| Eint of int
| Evar of string
| Ecall of string * expr list
+ | Echar of char
+ | Eaddrof of expr
+ | Eload of expr
type instr =
| Iassign of string * expr
@@ -17,12 +20,17 @@ type instr =
| Iwhile of expr * instr
| Iblock of instr list
| Ireturn of expr
- | Iprint of expr
| Icall of string * expr list
+ | Ideclare of typ * string
+ | Istore of expr * expr
type efun = {
- funargs: ( string ) list;
+ funargs: ( string * typ ) list;
funbody: instr;
+ funvartyp : (string, typ) Hashtbl.t;
+ funrettype : typ;
+ funvarinmem : (string, int) Hashtbl.t;
+ funstksz : int
}
type eprog = efun prog
diff --git a/src/elang_gen.ml b/src/elang_gen.ml
index 1d4db2d1429c325bdedeeedad12cb9ea8b081995..3ab03887da51ffb4e7fe4b6e0fe9ade6c29f33b8 100644
--- a/src/elang_gen.ml
+++ b/src/elang_gen.ml
@@ -39,86 +39,221 @@ let binop_of_tag =
| Tne -> Ecne
| _ -> assert false
+let binop_is_cmp =
+ function
+ | Ecle
+ | Eclt
+ | Ecge
+ | Ecgt
+ | Eceq
+ | Ecne -> true
+ | _ -> false
+
+let type_is_ptr =
+ function
+ | Tptr ty -> true
+ | _ -> false
+
+let are_compatible (t1 : typ) (t2 : typ) : bool =
+ match t1, t2 with
+ | Tint, Tint
+ | Tchar, Tchar
+ | Tint, Tchar
+ | Tchar, Tint -> true
+ | Tptr ty1, Tptr ty2 when ty1 = ty2 -> true
+ | _ -> false
+
+let are_lists_compatible (l1 : typ list) (l2 : typ list) : bool =
+ if List.length l1 != List.length l2
+ then false
+ else let comp = ref true
+ in List.iter2 (fun t1 t2 -> if not (are_compatible t1 t2) then comp := false) l1 l2;
+ !comp
+
+let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (e: expr) : typ res =
+ match e with
+ | Ebinop (b, e1, e2) ->
+ type_expr typ_var typ_fun e1 >>= fun t1 ->
+ type_expr typ_var typ_fun e2 >>= fun t2 ->
+ if t1 != Tvoid && t2 != Tvoid
+ then
+ match t1, t2 with
+ | Tptr ty, Tint
+ | Tptr ty, Tchar ->
+ (match b with
+ | Eadd -> OK (Tptr ty)
+ | Esub -> OK (Tptr ty)
+ | _ -> Error "Binop is not defined on pointer.")
+ | Tchar, Tptr ty
+ | Tint, Tptr ty ->
+ (match b with
+ | Eadd -> OK (Tptr ty)
+ | _ -> Error "Binop is not defined on pointer.")
+ | Tptr ty1, Tptr ty2 ->
+ if binop_is_cmp b
+ then
+ if ty1 = ty2
+ then OK Tint
+ else Error "Uncomparable pointers."
+ else
+ Error "Binop is not defined on pointer type."
+ | _ -> OK (Tint)
+ else Error "Binop is not defined on void type."
+ | Eunop (u, e) ->
+ type_expr typ_var typ_fun e >>= fun t ->
+ if t != Tvoid && t!= Tptr t
+ then OK Tint
+ else Error "Unop is not defined on void or pointer type."
+ | Eint i -> OK Tint
+ | Echar c -> OK Tchar
+ | Evar s ->
+ (match Hashtbl.find_option typ_var s with
+ | Some t when t != Tvoid -> OK t
+ | _ -> Error (Format.sprintf "Expression %s type is not defined." s))
+ | Ecall (f, exprs) ->
+ (match Hashtbl.find_option typ_fun f with
+ | Some (arg_types, ret_type) when ret_type != Tvoid ->
+ list_map_res (type_expr typ_var typ_fun) exprs >>= fun types ->
+ if types = arg_types
+ then OK ret_type
+ else Error (Format.sprintf "Unvalid argument types in function %s calling." f)
+ | _ -> Error "Function return type is not defined.")
+ | Eaddrof e ->
+ type_expr typ_var typ_fun e >>= fun t ->
+ OK (Tptr t)
+ | Eload e ->
+ type_expr typ_var typ_fun e >>= fun t ->
+ match t with
+ | Tptr ty -> OK ty
+ | _ -> Error "Unvalid loading."
+
+let rec addr_taken_expr (e: expr) : string Set.t =
+ match e with
+ | Ebinop (b, e1, e2) -> Set.union (addr_taken_expr e1) (addr_taken_expr e2)
+ | Eunop (b, e) -> addr_taken_expr e
+ | Eint _
+ | Evar _
+ | Echar _ -> Set.empty
+ | Ecall (_, e_list) -> set_concat (List.map addr_taken_expr e_list)
+ | Eaddrof e ->
+ (match e with
+ | Evar s -> Set.singleton s
+ | _ -> Set.empty)
+ | Eload e -> addr_taken_expr e
+
+let rec addr_taken_instr (i: instr) : string Set.t =
+ match i with
+ | Iassign (_, e) -> addr_taken_expr e
+ | Iif (e, i1, i2) -> set_concat ([addr_taken_expr e; addr_taken_instr i1; addr_taken_instr i2])
+ | Iwhile (e, i) -> Set.union (addr_taken_expr e) (addr_taken_instr i)
+ | Iblock i_list -> set_concat (List.map addr_taken_instr i_list)
+ | Ireturn e -> addr_taken_expr e
+ | Icall (_, e_list) -> set_concat (List.map addr_taken_expr e_list)
+ | Ideclare _ -> Set.empty
+ | Istore (e1, e2) -> Set.union (addr_taken_expr e1) (addr_taken_expr e2)
+
+
(* [make_eexpr_of_ast a] builds an expression corresponding to a tree [a]. If
the tree is not well-formed, fails with an [Error] message. *)
-let rec make_eexpr_of_ast (a: tree) : expr res =
+let rec make_eexpr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (a: tree) : expr res =
let res =
match a with
(* TODO *)
| IntLeaf i -> OK (Eint i)
| StringLeaf s -> OK (Evar s)
+ | CharLeaf c -> OK (Echar c)
| Node(t, [e1; e2]) when tag_is_binop t ->
- (let res1 = make_eexpr_of_ast e1
- in let res2 = make_eexpr_of_ast e2
- in match res1, res2 with
- | Error msg, _ -> Error msg
- | _, Error msg -> Error msg
- | OK expr1, OK expr2 -> OK (Ebinop (binop_of_tag t, expr1, expr2)))
+ (make_eexpr_of_ast typ_var typ_fun e1 >>= fun expr1 ->
+ make_eexpr_of_ast typ_var typ_fun e2 >>= fun expr2 ->
+ OK (Ebinop (binop_of_tag t, expr1, expr2)))
| Node(Tneg, [e]) ->
- (let res = make_eexpr_of_ast e
- in match res with
- | Error msg -> Error msg
- | OK expr -> OK (Eunop (Eneg, expr)))
+ make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
+ OK (Eunop (Eneg, expr))
| Node(Tcall, [StringLeaf f; Node(Targs, args)]) ->
- (let res = list_map_res make_eexpr_of_ast args
- in match res with
- | Error msg -> Error msg
- | OK exprs -> OK (Ecall (f, exprs)))
+ list_map_res (make_eexpr_of_ast typ_var typ_fun) args >>= fun exprs ->
+ list_map_res (type_expr typ_var typ_fun) exprs >>= fun types ->
+ (match Hashtbl.find_option typ_fun f with
+ | None -> Error (Format.sprintf "Unknown argument types of function %s." f)
+ | Some (arg_types, ret_type) ->
+ if are_lists_compatible types arg_types
+ then OK (Ecall (f, exprs))
+ else Error (Format.sprintf "Unvalid argument types in function %s calling." f))
+ | Node(Tmem, [MemopsLeaf memops; e]) ->
+ (match memops with
+ | [] -> make_eexpr_of_ast typ_var typ_fun e
+ | memop::rest ->
+ (make_eexpr_of_ast typ_var typ_fun (Node(Tmem, [MemopsLeaf rest; e])) >>= fun e_rest ->
+ match memop with
+ | Asterik -> OK (Eload e_rest)
+ | Ampersand -> OK (Eaddrof e_rest)))
| _ ->
Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s"
(string_of_ast a))
in
match res with
- OK o -> res
+ OK o -> type_expr typ_var typ_fun o >>= fun t -> res
| Error msg -> Error (Format.sprintf "In make_eexpr_of_ast %s:\n%s"
(string_of_ast a) msg)
-let rec make_einstr_of_ast (a: tree) : instr res =
+let rec make_einstr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (a: tree) : (instr * (string,typ) Hashtbl.t)res =
let res =
match a with
(* TODO *)
- | Node(Tassign, [StringLeaf s; e]) ->
- (let res_of_e = make_eexpr_of_ast e
- in match res_of_e with
- | OK exp -> OK (Iassign (s, exp))
- | Error msg -> Error msg)
+ (* typ_var a été ajouté à la valeur de retour de cette fonction
+ pour permettre la gestion des variables locales dans les if et while. *)
+ | Node(Tassign, [id; e]) ->
+ make_eexpr_of_ast typ_var typ_fun id >>= fun id_expr ->
+ type_expr typ_var typ_fun id_expr >>= fun tid ->
+ make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
+ type_expr typ_var typ_fun expr >>= fun te ->
+ (match id_expr with
+ | Evar s ->
+ if are_compatible te tid
+ then OK (Iassign (s, expr), typ_var)
+ else Error (Format.sprintf "Types %s and %s are not compatible." (string_of_typ tid) (string_of_typ te))
+ | Eload ptr_expr -> OK (Istore (ptr_expr, expr), typ_var)
+ | _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s" (string_of_ast a)))
| Node(Tif, [e; i1; i2]) ->
- (let res_of_e = make_eexpr_of_ast e
- in let res_of_i1 = make_einstr_of_ast i1
- in let res_of_i2 = make_einstr_of_ast i2
- in match res_of_e, res_of_i1, res_of_i2 with
- | Error msg, _, _ -> Error msg
- | _, Error msg, _ -> Error msg
- | _, _, Error msg -> Error msg
- | OK exp, OK inst1, OK inst2 -> OK (Iif (exp, inst1, inst2)))
+ make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
+ make_einstr_of_ast typ_var typ_fun i1 >>= fun (instr1, new_typ_var) ->
+ make_einstr_of_ast typ_var typ_fun i2 >>= fun (instr2, new_typ_var) ->
+ OK (Iif (expr, instr1, instr2), typ_var)
| Node(Twhile, [e; i]) ->
- (let res_of_e = make_eexpr_of_ast e
- in let res_of_i = make_einstr_of_ast i
- in match res_of_e, res_of_i with
- | Error msg, _ -> Error msg
- | _, Error msg -> Error msg
- | OK exp, OK inst-> OK (Iwhile (exp, inst)))
- | Node(Tblock, i_list) ->
- (let res_of_i_list = list_map_res make_einstr_of_ast i_list
- in match res_of_i_list with
- | Error msg -> Error msg
- | OK instr_list -> OK (Iblock instr_list))
+ make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
+ make_einstr_of_ast typ_var typ_fun i >>= fun (instr, new_typ_var) ->
+ OK (Iwhile (expr, instr), typ_var)
+ | Node(Tblock, i_list) ->
+ List.fold_left (fun acc i ->
+ acc >>= fun (cur_i_list, cur_typ_var) ->
+ make_einstr_of_ast cur_typ_var typ_fun i >>= fun (instr, new_typ_var) ->
+ OK(cur_i_list@[instr], new_typ_var))
+ (OK([], typ_var)) i_list >>= fun (instr_list, new_typ_var) ->
+ OK(Iblock(instr_list), new_typ_var)
| Node(Treturn, [e]) ->
- (let res_of_e = make_eexpr_of_ast e
- in match res_of_e with
- | OK exp -> OK (Ireturn exp)
- | Error msg -> Error msg)
- | Node(Tprint, [e]) ->
- (let res_of_e = make_eexpr_of_ast e
- in match res_of_e with
- | OK exp -> OK (Iprint exp)
- | Error msg -> Error msg)
- | Node(Tcall, [StringLeaf f; Node(Targs, args)]) ->
- (let res = list_map_res make_eexpr_of_ast args
- in match res with
- | Error msg -> Error msg
- | OK exprs -> OK (Icall (f, exprs)))
- | NullLeaf -> OK (Iblock [])
+ make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
+ OK (Ireturn expr, typ_var)
+ | Node(Tmem, [MemopsLeaf []; Node(Tcall, [StringLeaf f; Node(Targs, args)])]) ->
+ (list_map_res (make_eexpr_of_ast typ_var typ_fun) args >>= fun exprs ->
+ list_map_res (type_expr typ_var typ_fun) exprs >>= fun types ->
+ (match Hashtbl.find_option typ_fun f with
+ | None -> Error (Format.sprintf "Unknown argument types of function %s." f)
+ | Some (arg_types, ret_type) ->
+ if are_lists_compatible types arg_types
+ then OK (Icall (f, exprs), typ_var)
+ else Error (Format.sprintf "Unvalid argument types in function %s calling." f)))
+ | Node (Tdeclare, [TypeLeaf t; StringLeaf s]) ->
+ (if t != Tvoid
+ then
+ (if Hashtbl.mem typ_var s
+ then
+ Error (Format.sprintf "Variable %s already declared." s)
+ else
+ let new_typ_var = Hashtbl.copy typ_var
+ in Hashtbl.add new_typ_var s t;
+ OK (Ideclare (t ,s), new_typ_var))
+ else
+ Error (Format.sprintf "Can not declare void variable."))
+ | NullLeaf -> OK (Iblock [], typ_var)
| _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s"
(string_of_ast a))
in
@@ -126,21 +261,37 @@ let rec make_einstr_of_ast (a: tree) : instr res =
OK o -> res
| Error msg -> Error (Format.sprintf "In make_einstr_of_ast %s:\n%s"
(string_of_ast a) msg)
-
-let make_ident (a: tree) : string res =
+
+let make_ident (a: tree) : (string * typ) res =
match a with
- | Node (Targ, [s]) ->
- OK (string_of_stringleaf s)
+ | Node (Targ, [TypeLeaf t; StringLeaf s]) -> OK (s, t)
| a -> Error (Printf.sprintf "make_ident: unexpected AST: %s"
(string_of_ast a))
-let make_fundef_of_ast (a: tree) : (string * efun) res =
+let make_fundef_of_ast (typ_fun : (string, typ list * typ) Hashtbl.t) (a: tree) : (string * efun) res =
match a with
- | Node (Tfundef, [Node(Tfunname, [StringLeaf fname]); Node (Tfunargs, fargs); Node(Tfunbody, [fbody])]) ->
+ | Node (Tfundef, [Node(Tfuntype, [TypeLeaf t]); Node(Tfunname, [StringLeaf fname]); Node (Tfunargs, fargs); Node(Tfunbody, [fbody])]) ->
list_map_res make_ident fargs >>= fun fargs ->
- (* TODO *)
- make_einstr_of_ast fbody >>= fun fbody ->
- OK (fname, {funargs = fargs; funbody = fbody})
+ (* TODO *)
+ let typ_var = Hashtbl.of_list fargs
+ in let arg_types = List.map (fun (arg, typ) -> typ) fargs
+ in Hashtbl.add typ_fun fname (arg_types, t);
+ make_einstr_of_ast typ_var typ_fun fbody >>= fun (fbody, typ_var) ->
+ let ofs = ref 0
+ in let funvarinmem = Hashtbl.create 17
+ in List.iter (fun x ->
+ match Hashtbl.find_option typ_var x with
+ | None -> ()
+ | Some t ->
+ ofs := !ofs + size_type t;
+ Hashtbl.add funvarinmem x !ofs;) (List.rev (Set.to_list (addr_taken_instr fbody)));
+ OK (fname,
+ {funargs = fargs;
+ funbody = fbody;
+ funvartyp = typ_var;
+ funrettype = t;
+ funvarinmem = funvarinmem;
+ funstksz = !ofs})
| _ ->
Error (Printf.sprintf "make_fundef_of_ast: Expected a Tfundef, got %s."
(string_of_ast a))
@@ -148,7 +299,17 @@ let make_fundef_of_ast (a: tree) : (string * efun) res =
let make_eprog_of_ast (a: tree) : eprog res =
match a with
| Node (Tlistglobdef, l) ->
- list_map_res (fun a -> make_fundef_of_ast a >>= fun (fname, efun) -> OK (fname, Gfun efun)) l
+ let fun_typ = Hashtbl.create (List.length l) in
+ Hashtbl.replace fun_typ "print" ([Tint], Tvoid);
+ Hashtbl.replace fun_typ "print_int" ([Tint], Tvoid);
+ Hashtbl.replace fun_typ "print_char" ([Tchar], Tvoid);
+ List.fold_left (fun acc a ->
+ acc >>= fun f_list ->
+ make_fundef_of_ast fun_typ a >>= fun (fname, efun) ->
+ match List.assoc_opt fname f_list with
+ | None -> OK (f_list@[fname, Gfun efun])
+ | Some (Gfun dec) when dec.funbody = Iblock [] -> OK (List.remove_assoc fname f_list @ [fname, Gfun efun])
+ | _ -> Error (Format.sprintf "Multiple definitions of function %s." fname)) (OK []) l
| _ ->
Error (Printf.sprintf "make_fundef_of_ast: Expected a Tlistglobdef, got %s."
(string_of_ast a))
diff --git a/src/elang_print.ml b/src/elang_print.ml
index 8f7f8cf490c74b16488a4730058296cb8c9cd402..9d401ffdf50ed825896a55ee3df1572b557896d1 100644
--- a/src/elang_print.ml
+++ b/src/elang_print.ml
@@ -27,7 +27,9 @@ let rec dump_eexpr = function
| Eint i -> Printf.sprintf "%d" i
| Evar s -> Printf.sprintf "%s" s
| Ecall (f, args) -> Printf.sprintf "%s(%s)" f (String.concat ", " (List.map dump_eexpr args))
-
+ | Echar c -> Printf.sprintf "'%c'" c
+ | Eaddrof e -> Printf.sprintf "&%s" (dump_eexpr e)
+ | Eload e -> Printf.sprintf "*%s" (dump_eexpr e)
let indent_size = 2
let spaces n =
range (indent_size*n) |> List.map (fun _ -> ' ') |> String.of_list
@@ -49,28 +51,32 @@ let rec dump_einstr_rec indent oc i =
Format.fprintf oc "while (%s) %a\n"
(dump_eexpr cond) (dump_einstr_rec (indent)) i
| Iblock(il) ->
+ print_spaces oc indent;
Format.fprintf oc "{\n";
List.iter (Format.fprintf oc "%a" (dump_einstr_rec (indent + 1))) il;
print_spaces oc indent;
- Format.fprintf oc "}";
+ Format.fprintf oc "}\n";
| Ireturn(e) ->
print_spaces oc indent;
Format.fprintf oc "return %s;\n" (dump_eexpr e)
- | Iprint(e) ->
- print_spaces oc indent;
- Format.fprintf oc "print %s;\n" (dump_eexpr e)
| Icall(f, args) ->
print_spaces oc indent;
Format.fprintf oc "%s(%s);\n" f (String.concat ", " (List.map dump_eexpr args))
-
+ | Ideclare(t, s) ->
+ print_spaces oc indent;
+ Format.fprintf oc "%s %s;\n" (string_of_typ t) s
+ | Istore(p, e) ->
+ print_spaces oc indent;
+ Format.fprintf oc "*%s = %s;\n" (dump_eexpr p) (dump_eexpr e)
let dump_einstr oc i = dump_einstr_rec 0 oc i
-let dump_efun oc funname {funargs; funbody} =
- Format.fprintf oc "%s(%s) {\n%a\n}\n"
+let dump_efun oc funname {funargs; funbody; funrettype} =
+ Format.fprintf oc "%s %s(%s) %a\n"
+ (string_of_typ funrettype)
funname
- (String.concat "," funargs)
+ (String.concat "," (List.map (fun (s, t) -> Printf.sprintf "%s %s" (string_of_typ t) s) funargs))
dump_einstr funbody
let dump_eprog oc = dump_prog dump_efun oc
diff --git a/src/elang_run.ml b/src/elang_run.ml
index 880e93885acae46e84b0c19c54227c195cc7bd4d..f8fb9c05ea05e71e1af17ebea2ab2a7bb7dbb62e 100644
--- a/src/elang_run.ml
+++ b/src/elang_run.ml
@@ -2,6 +2,8 @@ open Elang
open Batteries
open Prog
open Utils
+open Builtins
+open Elang_gen
let binop_bool_to_int f x y = if f x y then 1 else 0
@@ -30,50 +32,57 @@ let eval_unop (u: unop) : int -> int =
(* [eval_eexpr st e] évalue l'expression [e] dans l'état [st]. Renvoie une
erreur si besoin. *)
-let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res =
+let rec eval_eexpr oc st (ep: eprog) (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (inmem_var : (string, int) Hashtbl.t) (sp : int) (e : expr) : (int * int state) res =
match e with
| Eint i -> OK (i, st)
| Evar s ->
- (match Hashtbl.find_option st.env s with
- | Some i -> OK (i, st)
- | None -> Error "Variable is not defined")
+ (match Hashtbl.find_opt inmem_var s with
+ | None -> OK (Hashtbl.find st.env s, st)
+ | Some ofs ->
+ Mem.read_bytes_as_int st.mem (sp - ofs) (size_type (Hashtbl.find typ_var s)) >>= fun v ->
+ OK (v, st))
| Ebinop (b, ex, ey) ->
- (let res_x = eval_eexpr oc st ep ex
- in match res_x with
- | Error msg -> Error msg
- | OK (x, st') ->
- let res_y = eval_eexpr oc st' ep ey
- in match res_y with
- | Error msg -> Error msg
- | OK (y, st'') -> OK (eval_binop b x y, st''))
+ eval_eexpr oc st ep typ_var typ_fun inmem_var sp ex >>= fun (x, st') ->
+ eval_eexpr oc st' ep typ_var typ_fun inmem_var sp ey >>= fun (y, st'') ->
+ type_expr typ_var typ_fun ex >>= fun tx ->
+ type_expr typ_var typ_fun ey >>= fun ty ->
+ (match tx, ty with
+ | Tptr t, Tint -> OK (eval_binop b x (y * size_type t), st'')
+ | Tint, Tptr t -> OK (eval_binop b (x * size_type t) y, st'')
+ | _ -> OK (eval_binop b x y, st''))
| Eunop (u, ex) ->
- (let res_x = eval_eexpr oc st ep ex
- in match res_x with
- | Error msg -> Error msg
- | OK (x, st') -> OK (eval_unop u x, st'))
+ eval_eexpr oc st ep typ_var typ_fun inmem_var sp ex >>= fun (x, st') ->
+ OK (eval_unop u x, st')
| Ecall (f, args) ->
- let (res : (int list * int state) res) = List.fold_left (
- fun (acc : (int list * int state) res) (arg : expr) ->
- match acc with
- | Error msg -> Error msg
- | OK (l, st') ->
- match eval_eexpr oc st' ep arg with
- | Error msg -> Error msg
- | OK (i, st'') -> OK ((l@[i]), st'')
- ) (OK([], st)) args
- in match res with
- | Error msg -> Error msg
- | OK (int_args, st') ->
+ (List.fold_left
+ (fun acc arg ->
+ acc >>= fun (l, st') ->
+ eval_eexpr oc st' ep typ_var typ_fun inmem_var sp arg >>= fun (i, st'') ->
+ OK ((l@[i]), st''))
+ (OK([], st)) args >>= fun(int_args, st') ->
match find_function ep f with
- | Error msg -> Error msg
| OK found_f ->
- match eval_efun oc st' ep found_f f int_args with
- | Error msg -> Error msg
- | OK (None, st'') -> Error (Format.sprintf "E: Function %s doesn't have a return value.\n" f)
- | OK (Some ret, st'') -> OK (ret, st'')
-
+ eval_efun oc st' ep found_f f int_args typ_fun sp >>= fun (ret_opt, st'') ->
+ OK (Option.get ret_opt, st'')
+ | Error msg ->
+ do_builtin oc st'.mem f int_args >>= fun (ret_opt) ->
+ OK (Option.get ret_opt, st'))
+ | Echar c -> OK (Char.code c, st)
+ | Eload e ->
+ eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (p, st') ->
+ type_expr typ_var typ_fun e >>= fun tp ->
+ Mem.read_bytes_as_int st'.mem p (size_type tp) >>= fun v ->
+ OK (v, st')
+ | Eaddrof e ->
+ match e with
+ | Evar s ->
+ (match Hashtbl.find_option inmem_var s with
+ | Some ofs -> OK (sp - ofs, st)
+ | None -> Error (Format.sprintf "Address of %s not found" s))
+ | Eload p -> eval_eexpr oc st ep typ_var typ_fun inmem_var sp p
+ | _ -> Error "Type cannot have an address"
-(* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
+(* [eval_einstr oc st ins] évalue l'instruction [ins] en partant de l'état [st].
Le paramètre [oc] est un "output channel", dans lequel la fonction "print"
écrit sa sortie, au moyen de l'instruction [Format.fprintf].
@@ -85,79 +94,88 @@ let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res =
lieu et que l'exécution doit continuer.
- [st'] est l'état mis à jour. *)
-and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) :
- (int option * int state) res =
+and eval_einstr oc (st: int state) (ep: eprog) (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (inmem_var : (string, int) Hashtbl.t) (sp : int) (ins: instr) :
+ (int option * int state * (string,typ) Hashtbl.t) res =
+ (* typ_var a été ajouté à la valeur de retour de cette fonction
+ pour permettre la gestion des variables locales dans les if et while. *)
match ins with
- | Iassign (s, e) ->
- (match eval_eexpr oc st ep e with
+ | Iassign (s, e) ->
+ (let replace st s v =
+ let new_env = Hashtbl.copy st.env
+ in Hashtbl.replace new_env s v;
+ {st with env = new_env}
+ in match eval_eexpr oc st ep typ_var typ_fun inmem_var sp e with
| Error msg -> Error msg
| OK (v, st') ->
- let replace st s v =
- let new_env = Hashtbl.copy st.env
- in Hashtbl.replace new_env s v;
- {st with env = new_env}
- in OK (None, replace st' s v))
+ match Hashtbl.find_opt inmem_var s with
+ | None -> OK (None, replace st' s v, typ_var)
+ | Some ofs ->
+ Mem.write_bytes st'.mem (sp - ofs) (split_bytes (size_type (Hashtbl.find typ_var s)) v) >>= fun _ ->
+ OK (None, st', typ_var))
| Iif (e, i1, i2) ->
- (match eval_eexpr oc st ep e with
- | Error msg -> Error msg
- | OK (v, st') -> if v = 0 then eval_einstr oc st' ep i2 else eval_einstr oc st' ep i1)
+ eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st') ->
+ if v != 0
+ then
+ eval_einstr oc st' ep typ_var typ_fun inmem_var sp i1 >>= fun (ret_opt, st', new_typ_var) ->
+ OK (ret_opt, st', typ_var)
+ else
+ eval_einstr oc st' ep typ_var typ_fun inmem_var sp i2 >>= fun (ret_opt, st', new_typ_var) ->
+ OK (ret_opt, st', typ_var)
| Iwhile (e, i) ->
- (match eval_eexpr oc st ep e with
- | Error msg -> Error msg
- | OK (v, st') ->
- if v = 1
- then (let res_i = eval_einstr oc st' ep i
- in match res_i with
- | Error msg -> Error msg
- | OK (r_opt, next_st) -> match r_opt with
- | None -> eval_einstr oc next_st ep (Iwhile (e, i))
- | Some r -> OK (r_opt, next_st))
- else OK(None, st'))
+ (eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st') ->
+ if v != 0
+ then eval_einstr oc st' ep typ_var typ_fun inmem_var sp i >>= fun (r_opt, next_st, new_typ_var) ->
+ match r_opt with
+ | None -> eval_einstr oc next_st ep typ_var typ_fun inmem_var sp (Iwhile (e, i))
+ | Some r -> OK (r_opt, next_st, typ_var)
+ else OK (None, st', typ_var))
| Iblock i_list ->
(match i_list with
- | [] -> OK (None, st)
+ | [] -> OK (None, st, typ_var)
| i::rest ->
- match eval_einstr oc st ep i with
+ match eval_einstr oc st ep typ_var typ_fun inmem_var sp i with
| Error msg -> Error msg
- | OK (Some r, next_st) -> OK (Some r, next_st)
- | OK (None, next_st) -> eval_einstr oc next_st ep (Iblock rest))
+ | OK (Some r, next_st, new_typ_var) -> OK (Some r, next_st, new_typ_var)
+ | OK (None, next_st, new_typ_var) -> eval_einstr oc next_st ep new_typ_var typ_fun inmem_var sp (Iblock rest))
| Ireturn e ->
- (match eval_eexpr oc st ep e with
- | Error msg -> Error msg
- | OK (v, st') -> OK(Some v, st'))
- | Iprint e ->
- (match eval_eexpr oc st ep e with
- | Error msg -> Error msg
- | OK (v, st') ->
- Format.fprintf oc "%d\n" v;
- OK(None, st'))
+ eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st') ->
+ OK(Some v, st', typ_var)
| Icall (f, args) ->
- let (res : (int list * int state) res) = List.fold_left (
- fun (acc : (int list * int state) res) (arg : expr) ->
- match acc with
- | Error msg -> Error msg
- | OK (l, st') ->
- match eval_eexpr oc st' ep arg with
- | Error msg -> Error msg
- | OK (i, st'') -> OK ((l@[i]), st'')
- ) (OK([], st)) args
- in match res with
- | Error msg -> Error msg
- | OK (int_args, st') ->
+ (List.fold_left
+ (fun acc arg ->
+ acc >>= fun (l, st') ->
+ eval_eexpr oc st' ep typ_var typ_fun inmem_var sp arg >>= fun (i, st'') ->
+ OK ((l@[i]), st''))
+ (OK([], st)) args >>= fun(int_args, st') ->
match find_function ep f with
- | Error msg -> Error msg
| OK found_f ->
- match eval_efun oc st' ep found_f f int_args with
- | Error msg -> Error msg
- | OK (_, st'') -> OK (None, st'')
-
+ (eval_efun oc st' ep found_f f int_args typ_fun sp >>= fun (_, st'') ->
+ OK (None, st'', typ_var))
+ | Error msg ->
+ (do_builtin oc st'.mem f int_args >>= fun _ ->
+ OK (None, st', typ_var)))
+ | Ideclare (t, s) ->
+ let new_typ_var = Hashtbl.copy typ_var
+ in Hashtbl.add new_typ_var s t;
+ OK (None, st, new_typ_var)
+ | Istore (p_expr, e) ->
+ eval_eexpr oc st ep typ_var typ_fun inmem_var sp p_expr >>= fun (addr, st') ->
+ eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st'') ->
+ type_expr typ_var typ_fun p_expr >>= fun tp ->
+ match tp with
+ | Tptr t ->
+ Mem.write_bytes st''.mem addr (split_bytes (size_type t) v) >>= fun u ->
+ OK (None, st'', typ_var)
+ | _ ->
+ Error "Storing in unvalid address"
+
(* [eval_efun oc st f fname vargs] évalue la fonction [f] (dont le nom est
[fname]) en partant de l'état [st], avec les arguments [vargs].
Cette fonction renvoie un couple (ret, st') avec la même signification que
pour [eval_einstr]. *)
-and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun)
- (fname: string) (vargs: int list)
+and eval_efun oc (st: int state) ep ({funargs; funbody; funvartyp; funrettype; funvarinmem; funstksz}: efun)
+ (fname: string) (vargs: int list) (typ_fun : (string, typ list * typ) Hashtbl.t) (sp : int)
: (int option * int state) res =
(* L'environnement d'une fonction (mapping des variables locales vers leurs
valeurs) est local et un appel de fonction ne devrait pas modifier les
@@ -166,15 +184,23 @@ and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun)
seulement ses arguments), puis on restore l'environnement de l'appelant. *)
let env_save = Hashtbl.copy st.env in
let env = Hashtbl.create 17 in
- match List.iter2 (fun a v -> Hashtbl.replace env a v) funargs vargs with
+ match List.iter2 (fun (a, t) v -> Hashtbl.replace env a v) funargs vargs with
| () ->
- eval_einstr oc { st with env } ep funbody >>= fun (v, st') ->
- OK (v, { st' with env = env_save })
+ eval_einstr oc { st with env } ep funvartyp typ_fun funvarinmem (sp + funstksz) funbody >>= fun (v, st', _) ->
+ OK (v, { st' with env = env_save })
| exception Invalid_argument _ ->
Error (Format.sprintf
"E: Called function %s with %d arguments, expected %d.\n"
fname (List.length vargs) (List.length funargs)
)
+let create_typ_fun (ep: eprog) : (string, typ list * typ) Hashtbl.t =
+ let typ_fun = Hashtbl.create (List.length ep)
+ in List.iter (fun (fname, gfun) ->
+ match gfun with
+ | Gfun efun ->
+ let arg_types = List.map (fun (arg, typ) -> typ) efun.funargs
+ in Hashtbl.add typ_fun fname (arg_types, efun.funrettype)) ep;
+ typ_fun
(* [eval_eprog oc ep memsize params] évalue un programme complet [ep], avec les
arguments [params].
@@ -191,7 +217,7 @@ and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun)
- [OK None] lorsque l'évaluation de la fonction termine sans renvoyer de valeur.
- [Error msg] lorsqu'une erreur survient.
- *)
+ *)
let eval_eprog oc (ep: eprog) (memsize: int) (params: int list)
: int option res =
let st = init_state memsize in
@@ -199,5 +225,6 @@ let eval_eprog oc (ep: eprog) (memsize: int) (params: int list)
(* ne garde que le nombre nécessaire de paramètres pour la fonction "main". *)
let n = List.length f.funargs in
let params = take n params in
- eval_efun oc st ep f "main" params >>= fun (v, _) ->
+ let typ_fun = create_typ_fun ep in
+ eval_efun oc st ep f "main" params typ_fun 0 >>= fun (v, _) ->
OK v
diff --git a/src/lexer.mll b/src/lexer.mll
index 9aa999daef2ff056c38dcc9864da6727fc7baec6..f4ac582138f38bd094a29a549a36328836de3d37 100644
--- a/src/lexer.mll
+++ b/src/lexer.mll
@@ -30,7 +30,6 @@ rule token = parse
| "void" { SYM_VOID }
| "char" { SYM_CHAR }
| "int" { SYM_INT }
- | "print" { SYM_PRINT }
| "struct" { SYM_STRUCT }
| "if" { SYM_IF }
| "else" { SYM_ELSE }
diff --git a/src/linear_liveness.ml b/src/linear_liveness.ml
index 5082e7fe9b9cf1460e1b2cf92889f7c7297d94f5..d8fe1aace6b30f06a261d51cdacf2fa0e884c5cf 100644
--- a/src/linear_liveness.ml
+++ b/src/linear_liveness.ml
@@ -8,7 +8,6 @@ open Rtl
let gen_live (i: rtl_instr) =
match i with
| Rbinop (b, rd, rs1, rs2) -> Set.of_list [rs1; rs2]
- | Rprint rs
| Runop (_, _, rs) -> Set.singleton rs
| Rconst (_, _) -> Set.empty
| Rbranch (_, rs1, rs2, _) -> Set.of_list [rs1; rs2]
@@ -26,7 +25,6 @@ let kill_live (i: rtl_instr) =
| Rmov (rd,_)
| Rcall (Some rd, _, _) -> Set.singleton rd
| Rbranch (_, _, _, _)
- | Rprint _
| Rret _
| Rjmp _
| Rlabel _
diff --git a/src/linear_run.ml b/src/linear_run.ml
index 80517908cb8721c7501ca4e4d8056b7b89d87251..7f8f471c8acc2cf5c80d7e077e4186c06283a26c 100644
--- a/src/linear_run.ml
+++ b/src/linear_run.ml
@@ -47,13 +47,6 @@ let rec exec_linear_instr oc lp fname f st (i: rtl_instr) =
OK (None, st)
| _ -> Error (Printf.sprintf "Mov on undefined register (%s)" (print_reg rs))
end
- | Rprint r ->
- begin match Hashtbl.find_option st.regs r with
- | Some s ->
- Format.fprintf oc "%d\n" s;
- OK (None, st)
- | _ -> Error (Printf.sprintf "Print on undefined register (%s)" (print_reg r))
- end
| Rret r ->
begin match Hashtbl.find_option st.regs r with
| Some s -> OK (Some s, st)
@@ -71,12 +64,20 @@ let rec exec_linear_instr oc lp fname f st (i: rtl_instr) =
| Some v -> Some (vs@[v])))
(Some []) args
in match vs_opt with
- | Some params -> find_function lp g >>= fun found_g ->
- (match rd_opt, exec_linear_fun oc lp st g found_g params with
- | _, Error msg -> Error msg
- | Some rd, OK (Some ret, st') -> exec_linear_instr oc lp fname f st' (Rconst (rd, ret))
- | Some rd, OK (None, st') -> Error (Printf.sprintf "Function %s doesn't have a return value" g)
- | None, OK (_, st') -> OK(None, st'))
+ | Some params ->
+ (match find_function lp g with
+ | OK found_g ->
+ (match rd_opt, exec_linear_fun oc lp st g found_g params with
+ | _, Error msg -> Error msg
+ | Some rd, OK (Some ret, st') -> exec_linear_instr oc lp fname f st' (Rconst (rd, ret))
+ | Some rd, OK (None, st') -> Error (Printf.sprintf "Function %s doesn't have a return value" g)
+ | None, OK (_, st') -> OK(None, st'))
+ | Error msg ->
+ (match rd_opt, do_builtin oc st.mem g params with
+ | _, Error msg -> Error msg
+ | Some rd, OK None -> Error (Printf.sprintf "Function %s doesn't have a return value.\n" g)
+ | Some rd, OK (Some ret) -> exec_linear_instr oc lp fname f st (Rconst (rd, ret))
+ | None, OK _ -> OK(None, st)))
| _ -> Error (Printf.sprintf "Function %s applied on undefined register" g)
end
diff --git a/src/ltl_gen.ml b/src/ltl_gen.ml
index 581f0c9b64f3710f3048ed905e62f31a5a1a1e9a..dbe0e577d949ac6127c82ee550b0d37a945edead 100644
--- a/src/ltl_gen.ml
+++ b/src/ltl_gen.ml
@@ -217,7 +217,6 @@ let written_rtl_regs_instr (i: rtl_instr) =
| Rconst (rd, _)
| Rmov (rd, _)
| Rcall (Some rd, _, _)-> Set.singleton rd
- | Rprint _
| Rret _
| Rlabel _
| Rbranch (_, _, _, _)
@@ -228,7 +227,6 @@ let read_rtl_regs_instr (i: rtl_instr) =
match i with
| Rbinop (_, _, rs1, rs2)
| Rbranch (_, rs1, rs2, _) -> Set.of_list [rs1; rs2]
- | Rprint rs
| Runop (_, _, rs)
| Rmov (_, rs)
| Rret rs -> Set.singleton rs
@@ -302,24 +300,6 @@ let ltl_instrs_of_linear_instr fname live_out allocation
load_loc reg_tmp1 allocation rs >>= fun (ls, rs) ->
store_loc reg_tmp1 allocation rd >>= fun (ld, rd) ->
OK (ls @ LMov(rd, rs) :: ld)
- | Rprint r ->
- let (save_a_regs, arg_saved, ofs) =
- save_caller_save
- (range 32)
- (- (numspilled+1)) in
- let parameter_passing =
- match Hashtbl.find_option allocation r with
- | None -> Error (Format.sprintf "Could not find allocation for register %d\n" r)
- | Some (Reg rs) -> OK [LMov(reg_a0, rs)]
- | Some (Stk o) -> OK [LLoad(reg_a0, reg_fp, (Archi.wordsize ()) * o, (archi_mas ()))]
- in
- parameter_passing >>= fun parameter_passing ->
- OK (LComment "Saving a0-a7,t0-t6" :: save_a_regs @
- LAddi(reg_sp, reg_s0, (Archi.wordsize ()) * (ofs + 1)) ::
- parameter_passing @
- LCall "print" ::
- LComment "Restoring a0-a7,t0-t6" :: restore_caller_save arg_saved)
-
| Rret r ->
load_loc reg_tmp1 allocation r >>= fun (l,r) ->
OK (l @ [LMov (reg_ret, r) ; LJmp epilogue_label])
diff --git a/src/parser.ml b/src/parser.ml
index 2e2c5f02499871c8a8fb311480a970dcbca55089..44e6a89a2ea7ddd961f9909aff536449b65c9192 100644
--- a/src/parser.ml
+++ b/src/parser.ml
@@ -53,7 +53,6 @@ let to_yacc_token = function
| SYM_LBRACKET -> Yaccparser.SYM_LBRACKET
| SYM_RBRACKET -> Yaccparser.SYM_RBRACKET
| SYM_ALLOC -> Yaccparser.SYM_ALLOC
-| SYM_PRINT -> Yaccparser.SYM_PRINT
| SYM_EXTERN -> Yaccparser.SYM_EXTERN
| SYM_INCLUDE(s) -> Yaccparser.SYM_INCLUDE s
| SYM_AMPERSAND -> Yaccparser.SYM_AMPERSAND
diff --git a/src/prog.ml b/src/prog.ml
index 5da26745e8461b83070928a8f3647a567394b2c7..47a60003ea27abce7cdc46fd0eec7d1bc40ae7e6 100644
--- a/src/prog.ml
+++ b/src/prog.ml
@@ -6,6 +6,19 @@ type mem_access_size =
| MAS4
| MAS8
+type typ =
+ | Tint
+ | Tchar
+ | Tvoid
+ | Tptr of typ
+
+let rec string_of_typ t =
+ match t with
+ | Tint -> "int"
+ | Tchar -> "char"
+ | Tvoid -> "void"
+ | Tptr ty -> Format.sprintf "%s*" (string_of_typ ty)
+
let string_of_mem_access_size mas =
match mas with
| MAS1 -> "{1}"
@@ -67,3 +80,10 @@ let find_function (ep: 'a prog) fname : 'a res =
match List.assoc_opt fname ep with
| Some (Gfun f) -> OK f
| _ -> Error (Format.sprintf "Unknown function %s\n" fname)
+
+let size_type (t: typ) : int =
+ match t with
+ | Tint -> 4
+ | Tchar -> 1
+ | Tptr _ -> 4
+ | Tvoid -> 0
\ No newline at end of file
diff --git a/src/rtl.ml b/src/rtl.ml
index 0360732db82bb6f335507b3ad392dba7e3ff7326..18d5f7d5a54cfaf976f19f1561f37f941f7659da 100644
--- a/src/rtl.ml
+++ b/src/rtl.ml
@@ -14,7 +14,6 @@ type rtl_instr = Rbinop of binop * reg * reg * reg
| Rmov of reg * reg
| Rret of reg
| Rlabel of int
- | Rprint of reg
| Rcall of reg option * string * reg list
type rtl_fun = { rtlfunargs: reg list;
@@ -29,7 +28,6 @@ let written_rtl_regs_instr (i: rtl_instr) =
| Runop (_, rd, _)
| Rconst (rd, _)
| Rmov (rd, _) -> Set.singleton rd
- | Rprint _
| Rret _
| Rlabel _
| Rbranch (_, _, _, _)
diff --git a/src/rtl_gen.ml b/src/rtl_gen.ml
index e49d304f4b9e73e7859a18212522e75e1a542809..0dde9d9909f83c0191a1bd748aeacc5b1275eed9 100644
--- a/src/rtl_gen.ml
+++ b/src/rtl_gen.ml
@@ -90,9 +90,6 @@ let rtl_instrs_of_cfg_node ((next_reg:int), (var2reg: (string*int) list)) (c: cf
| Creturn e ->
let r_e, l, next_reg', var2reg' = rtl_instrs_of_cfg_expr (next_reg, var2reg) e
in (l@[Rret r_e], next_reg', var2reg')
- | Cprint (e, i) ->
- let r_e, l, next_reg', var2reg' = rtl_instrs_of_cfg_expr (next_reg, var2reg) e
- in (l@[Rprint r_e; Rjmp i], next_reg', var2reg')
| Ccmp (e, i1, i2) ->
let cmp, e1, e2 = rtl_cmp_of_cfg_expr e
in let r1, l1, next_reg1, var2reg1 = rtl_instrs_of_cfg_expr (next_reg, var2reg) e1
diff --git a/src/rtl_print.ml b/src/rtl_print.ml
index a9c1224e8920af8ab16733a816846d794f1f02dc..a2837a7cb90c5201b72a81dcb0aeb9452a17e7ae 100644
--- a/src/rtl_print.ml
+++ b/src/rtl_print.ml
@@ -39,7 +39,6 @@ let dump_rtl_instr name (live_in, live_out) ?(endl="\n") oc (i: rtl_instr) =
Format.fprintf oc "jmp %s" (print_node s)
| Rmov (rd, rs) -> Format.fprintf oc "%s <- %s" (print_reg rd) (print_reg rs)
| Rret r -> Format.fprintf oc "ret %s" (print_reg r)
- | Rprint r -> Format.fprintf oc "print %s" (print_reg r)
| Rlabel n -> Format.fprintf oc "%s_%d:" name n
| Rcall (rd_opt, f, regs) ->
match rd_opt with
diff --git a/src/rtl_run.ml b/src/rtl_run.ml
index fb7a809f37c47f6bbaaa824117bffa843e4826d8..9e4ca5fca88968448fc13a4030f694c5aec38766 100644
--- a/src/rtl_run.ml
+++ b/src/rtl_run.ml
@@ -69,13 +69,6 @@ let rec exec_rtl_instr oc rp rtlfunname f st (i: rtl_instr) =
| Some s -> OK (Some s, st)
| _ -> Error (Printf.sprintf "Ret on undefined register (%s)" (print_reg r))
end
- | Rprint r ->
- begin match Hashtbl.find_option st.regs r with
- | Some s ->
- Format.fprintf oc "%d\n" s;
- OK (None, st)
- | _ -> Error (Printf.sprintf "Print on undefined register (%s)" (print_reg r))
- end
| Rlabel n -> OK (None, st)
| Rcall (rd_opt, g, args) ->
begin
@@ -88,13 +81,22 @@ let rec exec_rtl_instr oc rp rtlfunname f st (i: rtl_instr) =
| Some v -> Some (vs@[v])))
(Some []) args
in match vs_opt with
- | Some params -> find_function rp g >>= fun found_g ->
- (match rd_opt, exec_rtl_fun oc rp st g found_g params with
- | _, Error msg -> Error msg
- | Some rd, OK (Some ret, st') -> exec_rtl_instr oc rp rtlfunname f st' (Rconst (rd, ret))
- | Some rd, OK (None, st') -> Error (Printf.sprintf "Function %s doesn't have a return value" g)
- | None, OK (_, st') -> OK(None, st'))
+ | Some params ->
+ (match find_function rp g with
+ | OK found_g ->
+ (match rd_opt, exec_rtl_fun oc rp st g found_g params with
+ | _, Error msg -> Error msg
+ | Some rd, OK (Some ret, st') -> exec_rtl_instr oc rp rtlfunname f st' (Rconst (rd, ret))
+ | Some rd, OK (None, st') -> Error (Printf.sprintf "Function %s doesn't have a return value" g)
+ | None, OK (_, st') -> OK(None, st'))
+ | Error msg ->
+ (match rd_opt, do_builtin oc st.mem g params with
+ | _, Error msg -> Error msg
+ | Some rd, OK None -> Error (Printf.sprintf "Function %s doesn't have a return value.\n" g)
+ | Some rd, OK (Some ret) -> exec_rtl_instr oc rp rtlfunname f st (Rconst (rd, ret))
+ | None, OK _ -> OK(None, st)))
| _ -> Error (Printf.sprintf "Function %s applied on undefined register" g)
+
end
and exec_rtl_instr_at oc rp rtlfunname ({ rtlfunbody; } as f: rtl_fun) st i =
diff --git a/src/symbols.ml b/src/symbols.ml
index 71760ef8380d4e4fefc2f934565fab43c68fe9b4..ce80f8172a090f9653f95ba71b3e73879919e612 100644
--- a/src/symbols.ml
+++ b/src/symbols.ml
@@ -50,7 +50,6 @@ type token =
| SYM_LBRACKET
| SYM_RBRACKET
| SYM_ALLOC
- | SYM_PRINT
| SYM_EXTERN
| SYM_INCLUDE of string
| SYM_AMPERSAND
@@ -99,7 +98,6 @@ let string_of_symbol = function
| SYM_LBRACKET -> "SYM_LBRACKET"
| SYM_RBRACKET -> "SYM_RBRACKET"
| SYM_ALLOC -> "SYM_ALLOC"
-| SYM_PRINT -> "SYM_PRINT"
| SYM_EXTERN -> "SYM_EXTERN"
| SYM_INCLUDE(s) -> Printf.sprintf "SYM_INCLUDE(%s)" s
| SYM_AMPERSAND -> "SYM_AMPERSAND"
diff --git a/src/yaccparser.mly b/src/yaccparser.mly
index 3c9a390a95b44e92e4168327630e1d43af1873a3..c3449ba9e2ed1249b8b5583c3371c8721768c772 100644
--- a/src/yaccparser.mly
+++ b/src/yaccparser.mly
@@ -14,7 +14,7 @@
%token<int> SYM_INTEGER
%token SYM_PLUS SYM_MINUS SYM_ASTERISK SYM_DIV SYM_MOD
%token SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE
-%token SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA SYM_PRINT
+%token SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA
%token SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ
%left SYM_EQUALITY SYM_NOTEQ
@@ -68,7 +68,6 @@
| SYM_IF SYM_LPARENTHESIS expr SYM_RPARENTHESIS linstrs ntelse { Node (Tif, [$3; $5; $6]) }
| SYM_WHILE SYM_LPARENTHESIS expr SYM_RPARENTHESIS instr { Node( Twhile, [$3; $5]) }
| SYM_RETURN expr SYM_SEMICOLON { Node(Treturn, [$2]) }
- | SYM_PRINT expr SYM_SEMICOLON { Node(Tprint, [$2]) }
| linstrs { $1 };
ntelse :
SYM_ELSE linstrs { $2 }
@@ -87,7 +86,6 @@
| expr SYM_LEQ expr { Node (Tcle, [$1; $3]) }
| expr SYM_GEQ expr { Node (Tcge, [$1; $3]) }
| SYM_MINUS expr %prec UMINUS { Node (Tneg, [$2])}
- | integer { Node(Tint, [$1])}
| identifier { $1 }
| SYM_LPARENTHESIS expr SYM_RPARENTHESIS { $2 }
;
diff --git a/tests/Makefile b/tests/Makefile
index ef3fa0a92cb0f08481c60752b7797db738cd6921..d6ec16f0043ce0c983741d86351ac6a573c3c937 100644
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -1,7 +1,7 @@
# if make is launched with a DIR variable, pass it as the -f option to test.py
# 'make DIR=basic/mul*.e' launches all the files starting with mul in the basic directory
# otherwise, use basic/*.e as a default
-FILES := $(if $(DIR),$(DIR),funcall/*.e)
+FILES := $(if $(DIR),$(DIR),ptr/*.e)
OPTS := $(if $(OPTS), $(OPTS),)
diff --git a/tests/funcall/argswap.e.expect_lexer b/tests/funcall/argswap.e.expect_lexer
index 89b98c324fdb2b227f987c44d6cd1bba0c75859d..2c8a87dc1d273f5d6156be905b62504276797c7b 100644
--- a/tests/funcall/argswap.e.expect_lexer
+++ b/tests/funcall/argswap.e.expect_lexer
@@ -5,12 +5,12 @@ SYM_COMMA
SYM_IDENTIFIER(b)
SYM_RPARENTHESIS
SYM_LBRACE
-SYM_PRINT
+SYM_IDENTIFIER(print)
SYM_LPARENTHESIS
SYM_IDENTIFIER(a)
SYM_RPARENTHESIS
SYM_SEMICOLON
-SYM_PRINT
+SYM_IDENTIFIER(print)
SYM_LPARENTHESIS
SYM_IDENTIFIER(b)
SYM_RPARENTHESIS
@@ -30,12 +30,12 @@ SYM_COMMA
SYM_IDENTIFIER(b)
SYM_RPARENTHESIS
SYM_LBRACE
-SYM_PRINT
+SYM_IDENTIFIER(print)
SYM_LPARENTHESIS
SYM_IDENTIFIER(a)
SYM_RPARENTHESIS
SYM_SEMICOLON
-SYM_PRINT
+SYM_IDENTIFIER(print)
SYM_LPARENTHESIS
SYM_IDENTIFIER(b)
SYM_RPARENTHESIS
diff --git a/tests/funcall/print_and_fun.e.expect_lexer b/tests/funcall/print_and_fun.e.expect_lexer
index d8e49347bfd160352797416d6be13177edbc3ee4..834218f66d791aed054dec525bb4e0e33596260b 100644
--- a/tests/funcall/print_and_fun.e.expect_lexer
+++ b/tests/funcall/print_and_fun.e.expect_lexer
@@ -21,12 +21,12 @@ SYM_LPARENTHESIS
SYM_INTEGER(8)
SYM_RPARENTHESIS
SYM_SEMICOLON
-SYM_PRINT
+SYM_IDENTIFIER(print)
SYM_LPARENTHESIS
SYM_IDENTIFIER(a)
SYM_RPARENTHESIS
SYM_SEMICOLON
-SYM_PRINT
+SYM_IDENTIFIER(print)
SYM_LPARENTHESIS
SYM_IDENTIFIER(b)
SYM_RPARENTHESIS