From ebad7c57fc703eb8df6de8b51ec753cc1a10877b Mon Sep 17 00:00:00 2001
From: Youssef <youssef.sellami@student-cs.fr>
Date: Thu, 13 Mar 2025 19:03:02 +0100
Subject: [PATCH] Functions : parser and E
---
expr_grammar_action.g | 32 +++++-
src/ast.ml | 7 +-
src/elang.ml | 4 +-
src/elang_gen.ml | 15 +++
src/elang_print.ml | 5 +
src/elang_run.ml | 110 ++++++++++++++-------
src/regalloc.ml | 6 +-
tests/Makefile | 2 +-
tests/funcall/argswap.e.expect_lexer | 8 +-
tests/funcall/print_and_fun.e.expect_lexer | 4 +-
10 files changed, 142 insertions(+), 51 deletions(-)
diff --git a/expr_grammar_action.g b/expr_grammar_action.g
index 9d5d588..b871578 100644
--- a/expr_grammar_action.g
+++ b/expr_grammar_action.g
@@ -10,6 +10,9 @@ non-terminals ADD_EXPRS ADD_EXPR
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
+
axiom S
{
@@ -20,6 +23,10 @@ axiom S
open Batteries
open Utils
+ type after_id =
+ | Assign of tree
+ | Funcall of tree list
+ | Nothing
(* TODO *)
let rec resolve_associativity (term : tree) (other : (tag * tree) list) =
@@ -40,6 +47,11 @@ LPARAMS -> { [] }
REST_PARAMS -> SYM_COMMA LPARAMS { $2 }
REST_PARAMS -> { [] }
+LARGS -> EXPR REST_ARGS { $1::$2 }
+LARGS -> { [] }
+REST_ARGS -> SYM_COMMA LARGS { $2 }
+REST_ARGS -> { [] }
+
LINSTRS -> INSTR INSTRS { Node(Tblock, $1::$2) }
LINSTRS -> { NullLeaf }
INSTRS -> INSTR INSTRS { $1::$2 }
@@ -49,9 +61,18 @@ INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_LBRACE LINSTRS SYM_RB
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 SYM_ASSIGN EXPR SYM_SEMICOLON { Node(Tassign, [$1; $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 -> 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 }
+
ELSE -> SYM_ELSE SYM_LBRACE LINSTRS SYM_RBRACE { $3 }
ELSE -> { NullLeaf }
@@ -59,6 +80,8 @@ EXPR -> EQ_EXPR EQ_EXPRS { resolve_associativity $1 $2 }
EQ_EXPR -> CMP_EXPR CMP_EXPRS { resolve_associativity $1 $2 }
CMP_EXPR -> ADD_EXPR ADD_EXPRS { resolve_associativity $1 $2 }
ADD_EXPR -> MUL_EXPR MUL_EXPRS { resolve_associativity $1 $2 }
+ADD_EXPR -> SYM_MINUS MUL_EXPR MUL_EXPRS { resolve_associativity (Node(Tneg, [$2])) $3 }
+ADD_EXPR -> SYM_PLUS MUL_EXPR MUL_EXPRS { resolve_associativity $2 $3 }
MUL_EXPR -> FACTOR { $1 }
EQ_EXPRS -> SYM_EQUALITY EQ_EXPR EQ_EXPRS { (Tceq, $2)::$3 }
@@ -81,7 +104,12 @@ MUL_EXPRS -> SYM_MOD MUL_EXPR MUL_EXPRS { (Tmod, $2)::$3 }
MUL_EXPRS -> { [] }
FACTOR -> INTEGER { $1 }
-FACTOR -> IDENTIFIER { $1 }
+FACTOR -> IDENTIFIER AFTER_IDENTIFIER {
+ match $2 with
+ | Funcall args -> Node(Tcall, [$1; Node(Targs, args)])
+ | Nothing -> $1
+ | _ -> $1
+}
FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS { $2 }
IDENTIFIER -> SYM_IDENTIFIER {StringLeaf $1}
diff --git a/src/ast.ml b/src/ast.ml
index bfd93a8..cfb67d6 100644
--- a/src/ast.ml
+++ b/src/ast.ml
@@ -28,9 +28,9 @@ type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint
| Tclt | Tcgt | Tcle | Tcge | Tceq | Tne
| Tneg
| Tlistglobdef
- | Tfundef | Tfunname | Tfunargs | Tfunbody
+ | Tfundef | Tfunname | Tfunargs | Tfunbody | Tcall
| Tassignvar
- | Targ
+ | Targ | Targs
type tree = | Node of tag * tree list
| StringLeaf of string
@@ -73,7 +73,8 @@ let string_of_tag = function
| Tfunbody -> "Tfunbody"
| Tassignvar -> "Tassignvar"
| Targ -> "Targ"
-
+ | Tcall -> "Tcall"
+ | Targs -> "Targs"
(* Écrit un fichier .dot qui correspond à un AST *)
let rec draw_ast a next =
diff --git a/src/elang.ml b/src/elang.ml
index 7dc3280..38b4f66 100644
--- a/src/elang.ml
+++ b/src/elang.ml
@@ -6,9 +6,10 @@ type unop = Eneg
type expr =
Ebinop of binop * expr * expr
- | Eunop of unop * expr (*unused in grammar*)
+ | Eunop of unop * expr
| Eint of int
| Evar of string
+ | Ecall of string * expr list
type instr =
| Iassign of string * expr
@@ -17,6 +18,7 @@ type instr =
| Iblock of instr list
| Ireturn of expr
| Iprint of expr
+ | Icall of string * expr list
type efun = {
funargs: ( string ) list;
diff --git a/src/elang_gen.ml b/src/elang_gen.ml
index 86761b7..1d4db2d 100644
--- a/src/elang_gen.ml
+++ b/src/elang_gen.ml
@@ -54,6 +54,16 @@ let rec make_eexpr_of_ast (a: tree) : expr res =
| Error msg, _ -> Error msg
| _, Error msg -> Error msg
| OK expr1, OK 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)))
+ | 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)))
| _ ->
Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s"
(string_of_ast a))
@@ -103,6 +113,11 @@ let rec make_einstr_of_ast (a: tree) : instr res =
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 [])
| _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s"
(string_of_ast a))
diff --git a/src/elang_print.ml b/src/elang_print.ml
index 2da36d9..8f7f8cf 100644
--- a/src/elang_print.ml
+++ b/src/elang_print.ml
@@ -26,6 +26,7 @@ let rec dump_eexpr = function
| Eunop(u, e) -> Printf.sprintf "(%s %s)" (dump_unop u) (dump_eexpr e)
| 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))
let indent_size = 2
let spaces n =
@@ -58,6 +59,10 @@ let rec dump_einstr_rec indent oc i =
| 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))
+
let dump_einstr oc i = dump_einstr_rec 0 oc i
diff --git a/src/elang_run.ml b/src/elang_run.ml
index 13afe7c..e4509f6 100644
--- a/src/elang_run.ml
+++ b/src/elang_run.ml
@@ -30,26 +30,49 @@ 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 st (e : expr) : int res =
+let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res =
match e with
- | Eint i -> OK i
+ | Eint i -> OK (i, st)
| Evar s ->
(match Hashtbl.find_option st.env s with
- | Some i -> OK i
+ | Some i -> OK (i, st)
| None -> Error "Variable is not defined")
| Ebinop (b, ex, ey) ->
- (let res_x = eval_eexpr st ex
- in let res_y = eval_eexpr st ey
- in match res_x, res_y with
- | Error msg, _ -> Error msg
- | _, Error msg -> Error msg
- | OK x, OK y -> OK (eval_binop b x y))
+ (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''))
| Eunop (u, ex) ->
- (let res_x = eval_eexpr st ex
+ (let res_x = eval_eexpr oc st ep ex
in match res_x with
| Error msg -> Error msg
- | OK x -> OK (eval_unop u x ))
-
+ | OK (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') ->
+ 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_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
Le paramètre [oc] est un "output channel", dans lequel la fonction "print"
@@ -62,59 +85,78 @@ let rec eval_eexpr st (e : expr) : int res =
lieu et que l'exécution doit continuer.
- [st'] est l'état mis à jour. *)
-let rec eval_einstr oc (st: int state) (ins: instr) :
+and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) :
(int option * int state) res =
match ins with
| Iassign (s, e) ->
- (match eval_eexpr st e with
+ (match eval_eexpr oc st ep e with
| Error msg -> Error msg
- | OK v ->
+ | 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))
+ in OK (None, replace st' s v))
| Iif (e, i1, i2) ->
- (match eval_eexpr st e with
+ (match eval_eexpr oc st ep e with
| Error msg -> Error msg
- | OK v -> if v=1 then eval_einstr oc st i1 else eval_einstr oc st i2)
+ | OK (v, st') -> if v = 1 then eval_einstr oc st' ep i1 else eval_einstr oc st' ep i2)
| Iwhile (e, i) ->
- (match eval_eexpr st e with
+ (match eval_eexpr oc st ep e with
| Error msg -> Error msg
- | OK v ->
- if v=1
- then (let res_i = eval_einstr oc st i
+ | 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 (Iwhile (e, i))
+ | None -> eval_einstr oc next_st ep (Iwhile (e, i))
| Some r -> OK (r_opt, next_st))
- else OK(None, st))
+ else OK(None, st'))
| Iblock i_list ->
(match i_list with
| [] -> OK (None, st)
| i::rest ->
- match eval_einstr oc st i with
+ match eval_einstr oc st ep 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 (Iblock rest))
+ | OK (None, next_st) -> eval_einstr oc next_st ep (Iblock rest))
| Ireturn e ->
- (match eval_eexpr st e with
+ (match eval_eexpr oc st ep e with
| Error msg -> Error msg
- | OK v -> OK(Some v, st))
+ | OK (v, st') -> OK(Some v, st'))
| Iprint e ->
- (match eval_eexpr st e with
+ (match eval_eexpr oc st ep e with
| Error msg -> Error msg
- | OK v ->
+ | OK (v, st') ->
Format.fprintf oc "%d\n" v;
- OK(None, st))
+ OK(None, st'))
+ | 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') ->
+ 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 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]. *)
-let eval_efun oc (st: int state) ({ funargs; funbody}: efun)
+and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun)
(fname: string) (vargs: int list)
: (int option * int state) res =
(* L'environnement d'une fonction (mapping des variables locales vers leurs
@@ -126,7 +168,7 @@ let eval_efun oc (st: int state) ({ funargs; funbody}: efun)
let env = Hashtbl.create 17 in
match List.iter2 (fun a v -> Hashtbl.replace env a v) funargs vargs with
| () ->
- eval_einstr oc { st with env } funbody >>= fun (v, st') ->
+ eval_einstr oc { st with env } ep funbody >>= fun (v, st') ->
OK (v, { st' with env = env_save })
| exception Invalid_argument _ ->
Error (Format.sprintf
@@ -157,5 +199,5 @@ 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 f "main" params >>= fun (v, _) ->
+ eval_efun oc st ep f "main" params >>= fun (v, _) ->
OK v
diff --git a/src/regalloc.ml b/src/regalloc.ml
index a843912..897da01 100644
--- a/src/regalloc.ml
+++ b/src/regalloc.ml
@@ -92,6 +92,7 @@ let make_interf_live
(* TODO *)
Hashtbl.iter (fun i regs -> Set.iter (fun x -> Set.iter (fun y -> if x < y then add_interf rig x y) regs) regs) live
+
(* [build_interference_graph live_out] construit, en utilisant les fonctions que
vous avez écrites, le graphe d'interférence en fonction de la vivacité des
variables à la sortie des nœuds donné par [live_out].
@@ -122,12 +123,9 @@ let build_interference_graph (live_out : (int, reg Set.t) Hashtbl.t) code : (reg
[rig]. *)
let remove_from_rig (rig : (reg, reg Set.t) Hashtbl.t) (v: reg) : unit =
(* TODO *)
- while Hashtbl.mem rig v do
- Hashtbl.remove rig v
- done;
+ Hashtbl.remove rig v;
Hashtbl.iter (fun x regs -> Hashtbl.modify x (Set.remove v) rig) rig
-
(* Type représentant les différentes décisions qui peuvent être prises par
l'allocateur de registres.
diff --git a/tests/Makefile b/tests/Makefile
index 7f5a992..ef3fa0a 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),basic/*.e)
+FILES := $(if $(DIR),$(DIR),funcall/*.e)
OPTS := $(if $(OPTS), $(OPTS),)
diff --git a/tests/funcall/argswap.e.expect_lexer b/tests/funcall/argswap.e.expect_lexer
index 2c8a87d..89b98c3 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_IDENTIFIER(print)
+SYM_PRINT
SYM_LPARENTHESIS
SYM_IDENTIFIER(a)
SYM_RPARENTHESIS
SYM_SEMICOLON
-SYM_IDENTIFIER(print)
+SYM_PRINT
SYM_LPARENTHESIS
SYM_IDENTIFIER(b)
SYM_RPARENTHESIS
@@ -30,12 +30,12 @@ SYM_COMMA
SYM_IDENTIFIER(b)
SYM_RPARENTHESIS
SYM_LBRACE
-SYM_IDENTIFIER(print)
+SYM_PRINT
SYM_LPARENTHESIS
SYM_IDENTIFIER(a)
SYM_RPARENTHESIS
SYM_SEMICOLON
-SYM_IDENTIFIER(print)
+SYM_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 834218f..d8e4934 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_IDENTIFIER(print)
+SYM_PRINT
SYM_LPARENTHESIS
SYM_IDENTIFIER(a)
SYM_RPARENTHESIS
SYM_SEMICOLON
-SYM_IDENTIFIER(print)
+SYM_PRINT
SYM_LPARENTHESIS
SYM_IDENTIFIER(b)
SYM_RPARENTHESIS
--
GitLab