ldb/style.css

@@ -54,7 +54,7 @@ html {
 }
 #body{
     display: grid;
-    grid-template-columns: [ctrl] 300px [code] 250px [outcfg] 600px [state] 700px;
+    grid-template-columns: [ctrl] 250px [code] 400px [outcfg] 500px [state] 700px;
     grid-template-rows: [row1] 200px [row2] 200px [row3] 400px [row4];
 }
 #code {

opts.mk

+CONF_OPTS=
+
+# Use handwritten lexer
+CONF_OPTS+=-l
+
+# Use ocamllex lexer
+#CONF_OPTS+=-L
+
+# Use alpaga parser
+CONF_OPTS+=-a
+
+# Use menhir parser
+#CONF_OPTS+=-m

runtime/.gitignore

+tmp/
+*.o
\ No newline at end of file

runtime/lib32.s

+	.include "syscall_numbers.s"
 	  .global atoi
 	  .global print_int
 	  .global println
@@ -66,7 +67,7 @@ li a3, 0
 li a4, 0
 li a5, 0
 li a6, 0
-li a7, 64
+li a7, SYSCALL_WRITE
 ecall
 jr ra
 print_char:

runtime/lib64.s

+.include "syscall_numbers.s"
   .global atoi
   .global print_int
   .global println
@@ -55,6 +56,7 @@ jal ra, print_a1
 ld ra, 0(sp)
 addi sp, sp, 8
 jr ra
+
 print_a1:
 addi sp, sp, -8
 sd ra,0(sp)
@@ -68,9 +70,10 @@ li a3, 0
 li a4, 0
 li a5, 0
 li a6, 0
-li a7, 64
+li a7, 	SYSCALL_WRITE
 ecall
 jr ra
+
 print_char:
 addi sp, sp, -8
 sd ra, 0(sp)

runtime/link.ld

@@ -4,7 +4,7 @@ heap_size = 0x2000;
 SECTIONS
 {
 /* text: test code section */
-. = 0x200;
+. = 0x2000000;
 .text :
 {
 *(.text)

runtime/linux/syscall_numbers.s

+.equ SYSCALL_WRITE, 64
+.equ SYSCALL_EXIT, 93

src/.merlin

-S .
-B _build
-PKG lwt
-PKG lwt.unix
-PKG logs
-PKG logs.lwt
-PKG batteries
-PKG yojson
-PKG websocket
-PKG websocket-lwt-unix
\ No newline at end of file

src/Makefile

-SRC=archi.ml ast.ml builtins.ml config.ml cfg_constprop.ml cfg_dead_assign.ml		\
-cfg.ml cfg_print.ml cfg_gen.ml cfg_nop_elim.ml cfg_run.ml elang.ml							\
-elang_print.ml elang_gen.ml elang_run.ml generated_parser.ml lexer_generator.ml	\
-linear_dse.ml linear_liveness.ml linear.ml linear_print.ml linear_gen.ml				\
-linear_run.ml ltl.ml ltl_print.ml ltl_gen.ml ltl_run.ml ltl_debug.ml main.ml		\
-options.ml parser.ml prog.ml regalloc.ml report.ml riscv.ml rtl.ml rtl_print.ml	\
-rtl_gen.ml rtl_run.ml symbols.ml utils.ml
+include ../opts.mk
 
-TG = main.native
+SRC=archi.ml ast.ml builtins.ml config.ml cfg_constprop.ml cfg_dead_assign.ml	\
+cfg.ml cfg_print.ml cfg_gen.ml cfg_liveness.ml cfg_nop_elim.ml cfg_run.ml			\
+elang.ml elang_print.ml elang_gen.ml elang_run.ml e_regexp.ml									\
+generated_parser.ml lexer_generator.ml linear_dse.ml linear_liveness.ml				\
+linear.ml linear_print.ml linear_gen.ml linear_run.ml ltl.ml ltl_print.ml			\
+ltl_gen.ml ltl_run.ml ltl_debug.ml main.ml options.ml parser.ml prog.ml				\
+regalloc.ml report.ml riscv.ml rtl.ml rtl_print.ml rtl_gen.ml rtl_run.ml			\
+symbols.ml tokenize.ml utils.ml
+
+TG = main.exe
+
+PROF:=$(if $(PROF),-ocamlopt ocamloptp,)
 
 all: $(TG)
 
 $(TG): $(SRC)
-	ocamlbuild -cflags -warn-error,"+a" -use-ocamlfind $(TG)
+	dune build $(TG)
+	# ocamlbuild $(PROF) -cflags  -warn-error,"+a-26" -cflags -w,"-26" -menhir "menhir --unused-tokens" -use-ocamlfind $(TG)
+
+test_lexer: archi.ml config.ml e_regexp.ml lexer_generator.ml symbols.ml test_lexer.ml utils.ml
+	dune exec ./test_lexer.exe
+	dot -Tsvg /tmp/dfa.dot -o /tmp/dfa.svg
+	dot -Tsvg /tmp/nfa.dot -o /tmp/nfa.svg
+
+config.ml: ../configure ../opts.mk
+	cd .. && ./configure ${CONF_OPTS}
 
 clean:
-	rm -rf _build
-	rm -f config.ml main.native
+	dune clean
+	rm -f config.ml

src/_tags

-true: debug
-true: bin_annot
-<runtime>: -traverse
-<*>: package(lwt lwt.unix logs logs.lwt batteries yojson websocket websocket-lwt-unix)
-true: thread
-<tykernel>: -traverse
\ No newline at end of file

src/archi.ml

+
 type archi = A64 | A32
 
-let wordsize = ref 8
-let assembler = ref "riscv64-unknown-elf-gcc"
-let instrsuffix = ref 'd'
 let archi = ref A64
-let nbits = ref 64
+let nbits () =
+  match !archi with
+  | A64 -> 64
+  | A32 -> 32
+
+let wordsize () = nbits () / 8
+
+let assembler () =
+  let opts =
+    match !archi with
+    | A64 -> "-march=rv64imafdc -mabi=lp64d"
+    | A32 -> "-march=rv32imafdc -mabi=ilp32"
+  in
+  Format.sprintf "%s %s" Config.rv_as opts
+
+let linker () =
+  let opts =
+    match !archi with
+      A64 -> "-melf64lriscv"
+    | A32 -> "-melf32lriscv"
+  in
+  Format.sprintf "%s %s" Config.rv_ld opts
+
+let instrsuffix () =
+  match !archi with
+  | A64 -> 'd'
+  | A32 -> 'w'
+
+let qemu () =
+  match !archi with
+  | A64 -> Config.qemu64
+  | A32 -> Config.qemu32
 
 let heapstart = ref 8
 
-let init_archi a () =
-  begin match a with
-    | A64 ->
-      begin
-        wordsize := 8;
-        assembler := "riscv64-unknown-elf-gcc";
-        instrsuffix := 'd';
-        archi := A64;
-      end
-    | A32 ->
-      begin
-        wordsize := 4;
-        assembler := "riscv32-unknown-elf-gcc";
-        instrsuffix := 'w';
-        archi := A32;
-      end
-  end
-  ;
-  nbits := !wordsize *8;
+type target_system =
+  | Linux
+  | Xv6
+
+let target = ref Linux
+
+let lib_syscall () =
+  match !target with
+  | Linux -> "linux"
+  | Xv6 -> "xv6"
+
+let target_data_segment t =
+  match t with
+  | Linux -> "8000000"
+  | Xv6 -> "2000"
+
+let runtime_lib_include_path () =
+  Format.sprintf "%s/%s" Config.runtime_dir (lib_syscall ())
+
+let runtime_lib_path () =
+  Format.sprintf "%s/lib%d.s" Config.runtime_dir (nbits ())

src/ast.ml

 open Batteries
-open BatPrintf
+
+(* Les AST sont des arbres, du type [tree], étiquetés par des [tag].
+
+   Un arbre [tree] est soit un nœud [Node(t, children)] où [t] est un tag et
+   [children] une liste de sous-arbres ; soit une feuille qui contient une
+   chaîne de caractères ([StringLeaf]), un entier ([IntLeaf]), un caractère
+   ([CharLeaf]), ou rien du tout ([NullLeaf]).
+
+   La signification des différents tags :
+
+   - importe peu : vous pouvez définir de nouveaux types de tags si ça vous
+   semble nécessaire / profitable, pour peu de compléter la fonction
+   [string_of_tag] ci-dessous.
+
+   - devrait être assez claire d'après le nom du tag ou l'utilisation qui en est
+   faite dans l'exemple donné dans le sujet.
+
+   - peut être demandée à votre encadrant de TP favori (ou celui présent en
+   séance, à défaut)
+
+
+*)
 
 type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint
          | Tint
@@ -9,7 +30,7 @@ type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint
          | Tlistglobdef
          | Tfundef | Tfunname | Tfunargs | Tfunbody
          | Tassignvar
-         | Targ | Targs
+         | Targ
 
 type tree = | Node of tag * tree list
             | StringLeaf of string
@@ -52,9 +73,9 @@ let string_of_tag = function
   | Tfunbody -> "Tfunbody"
   | Tassignvar -> "Tassignvar"
   | Targ -> "Targ"
-  | Targs -> "Targs"
 
-(* return (node, nextnode, dotcode) *)
+
+(* Écrit un fichier .dot qui correspond à un AST *)
 let rec draw_ast a next =
   match a with
   | Node (t, l) ->

src/cfg.ml

 open Elang
 open Prog
-open Utils
 open Batteries
 open BatList
 
@@ -26,10 +25,35 @@ type cfg_fun = {
 type cprog = cfg_fun prog
 
 
-let size_binop b e1 e2 =
+(* [succs cfg n] donne l'ensemble des successeurs d'un nœud [n] dans un CFG
+   [cfg]. *)
+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]
+  | Some (Cnop s) -> Set.singleton s
+
+
+(* [preds cfg n] donne l'ensemble des prédécesseurs d'un nœud [n] dans un CFG [cfg]
+   *)
+let preds cfgfunbody n =
+  Hashtbl.fold (fun m m' acc ->
+      match m' with
+      | Cassign (_, _, s)
+      | Cprint (_, s)
+      | Cnop s -> if s = n then Set.add m acc else acc
+      | Creturn _ -> acc
+      | Ccmp (_, s1, s2) -> if s1 = n || s2 = n then Set.add m acc else acc
+    ) cfgfunbody Set.empty
+
+
+let size_binop _ e1 e2 =
   1 + e1 + e2
 
-let size_unop u e =
+let size_unop _ e =
   1 + e
 
 let rec size_expr (e: expr) : int =
@@ -37,15 +61,16 @@ let rec size_expr (e: expr) : int =
   | Ebinop (b, e1, e2) -> size_binop b (size_expr e1) (size_expr e2)
   | Eunop (u, e) -> size_unop u (size_expr e)
   | Eint _ -> 1
-  | Evar v -> 1
+  | Evar _ -> 1
 
-let rec size_instr (i: cfg_node) : int =
+let size_instr (i: cfg_node) : int =
   match (i : cfg_node) with
-  | Cassign (v, e, s) -> 1 + size_expr e
+  | Cassign (_, e, _) -> 1 + size_expr e
   | Creturn e -> 1 + (size_expr e)
-  | Cprint (e, s) -> 1 + (size_expr e)
-  | Ccmp (e, s1, s2) -> 1 + size_expr e
-  | Cnop s -> 1
+  | Cprint (e, _) -> 1 + (size_expr e)
+  | Ccmp (e, _, _) -> 1 + size_expr e
+  | Cnop _ -> 1
 
 let size_fun f =
-  Hashtbl.fold (fun k v acc -> acc + size_instr v) f 0
+  Hashtbl.fold (fun _ v acc -> acc + size_instr v) f 0
+

src/cfg_constprop.ml

@@ -3,6 +3,9 @@ open Cfg
 open Elang_run
 open Prog
 open Utils
+open Report
+open Cfg_print
+open Options
 
 (* [simple_eval_eexpr e] evaluates an expression [e] with no variables. Raises
    an exception if the expression contains variables. *)
@@ -34,8 +37,8 @@ let rec const_prop_expr (e: expr) =
 let constant_propagation_instr (i: cfg_node) : cfg_node =
     i
 
-let constant_propagation_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
-  let ht = Hashtbl.map (fun n m ->
+let constant_propagation_fun ({ cfgfunbody; _ } as f: cfg_fun) =
+  let ht = Hashtbl.map (fun _ m ->
       constant_propagation_instr m
     ) cfgfunbody in
   { f with cfgfunbody = ht}
@@ -45,4 +48,13 @@ let constant_propagation_gdef = function
     Gfun (constant_propagation_fun f)
 
 let constant_propagation p =
-  assoc_map constant_propagation_gdef p
+  if !Options.no_cfg_constprop
+  then p
+  else assoc_map constant_propagation_gdef p
+
+let pass_constant_propagation p =
+  let cfg = constant_propagation p in
+  record_compile_result "Constprop";
+  dump (!cfg_dump >*> fun s -> s ^ "1") dump_cfg_prog cfg
+    (call_dot "cfg-after-cstprop" "CFG after Constant Propagation");
+  OK cfg

src/cfg_dead_assign.ml

@@ -2,68 +2,45 @@ open Batteries
 open Cfg
 open Prog
 open Utils
-
-(* Liveness analysis *)
-
-(* [vars_in_expr e] returns the set of variables appearing in [e]. *)
-let rec vars_in_expr (e: expr) =
-   Set.empty
-
-(* [live_cfg_node node live_after] gives the set of variables live before the
-   node [node], given the set [live_after] of variables live after this node. *)
-let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
-   live_after
-
-(* [succs cfg n] gives the successors of a node [n] in a CFG [cfg]. *)
-let succs cfg n =
-  match Hashtbl.find_option cfg n with
-  | None -> []
-  | Some (Cprint (_, s))
-  | Some (Cfg.Cassign (_, _, s)) -> [s]
-  | Some (Cfg.Creturn _) -> []
-  | Some (Cfg.Ccmp (_, s1, s2)) -> [s1;s2]
-  | Some (Cnop s) -> [s]
-
-(* Computes the set of live variables after a node [n] in a CFG [cfg].
-   [lives] is a mapping from CFG node identifier to the set of variables that
-   are live before this node.
-*)
-let live_after_node cfg n (lives: (int, string Set.t) Hashtbl.t) : string Set.t =
-   Set.empty
-
-(* [live_cfg_nodes cfg lives] makes one iteration of the fixpoint computation.
-
-   This returns a boolean that is true if some progress has been made in this
-   iteration (the set of variables live at at least one node has changed), false
-   otherwise. *)
-let live_cfg_nodes cfg (lives : (int, string Set.t) Hashtbl.t) =
-   false
-
-(* [live_cfg_fun f] computes the set of live variables at each point by
-   iterating [live_cfg_nodes] as long as progress is made. *)
-let live_cfg_fun ({ cfgfunargs; cfgfunbody; cfgentry }: cfg_fun) =
-  let lives : (int, string Set.t) Hashtbl.t = Hashtbl.create 17 in
-  let rec aux () =
-    if live_cfg_nodes cfgfunbody lives
-    then aux ()
-    else () in
-  aux ();
-  lives
-
-(* Dead Assign Elimination *)
-
-(* [dead_assign_elimination_fun f] performs DAE on function [f]. *)
-let dead_assign_elimination_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
+open Cfg_liveness
+open Report
+open Cfg_print
+open Options
+
+(* Dead Assign Elimination  -- Élimination des affectations mortes *)
+
+(* [dead_assign_elimination_fun f] élimine les affectations mortes dans la
+   function [f]. Cette fonction renvoie un couple [(f',c)] oú [f'] est la
+   nouvelle fonction, et [c] est un booléen qui indique si du progrès a été
+   fait. *)
+let dead_assign_elimination_fun ({ cfgfunbody; _ } as f: cfg_fun) =
+  let changed = ref false in
   let cfgfunbody =
     Hashtbl.map (fun (n: int) (m: cfg_node) ->
         match m with
            (* TODO *)
         | _ -> m
       ) cfgfunbody in
-  { f with cfgfunbody }
+  ({ f with cfgfunbody }, !changed )
+
+(* Applique l'élimination de code mort autant de fois que nécessaire. Testez
+   notamment sur le fichier de test [basic/useless_assigns.e]. *)
+let rec iter_dead_assign_elimination_fun f =
+  let f, c = dead_assign_elimination_fun f in
+   (* TODO *)
+   f
 
 let dead_assign_elimination_gdef = function
-    Gfun f -> Gfun (dead_assign_elimination_fun f)
+    Gfun f -> Gfun (iter_dead_assign_elimination_fun f)
 
 let dead_assign_elimination p =
-  assoc_map dead_assign_elimination_gdef p
+  if !Options.no_cfg_dae
+  then p
+  else assoc_map dead_assign_elimination_gdef p
+
+let pass_dead_assign_elimination cfg =
+  let cfg = dead_assign_elimination cfg in
+  record_compile_result "DeadAssign";
+  dump (!cfg_dump >*> fun s -> s ^ "2") dump_cfg_prog cfg
+    (call_dot "cfg-after-dae" "CFG after DAE");
+  OK cfg

src/cfg_gen.ml

@@ -3,6 +3,9 @@ open Elang
 open Cfg
 open Utils
 open Prog
+open Report
+open Cfg_print
+open Options
 
 (* [cfg_expr_of_eexpr e] converts an [Elang.expr] into a [expr res]. This should
    always succeed and be straightforward.
@@ -11,7 +14,17 @@ open Prog
    but not to [Cfg.expr], hence the distinction.
 *)
 let rec cfg_expr_of_eexpr (e: Elang.expr) : expr res =
-   Error "cfg_expr_of_eexpr not implemented yet."
+  match e with
+  | Elang.Ebinop (b, e1, e2) ->
+    cfg_expr_of_eexpr e1 >>= fun ee1 ->
+    cfg_expr_of_eexpr e2 >>= fun ee2 ->
+    OK (Ebinop (b, ee1, ee2))
+  | Elang.Eunop (u, e) ->
+    cfg_expr_of_eexpr e >>= fun ee ->
+    OK (Eunop (u, ee))
+  | Elang.Eint i -> OK (Eint i)
+  | Elang.Evar v ->
+    OK (Evar v)
 
 (* [cfg_node_of_einstr next cfg succ i] builds the CFG node(s) that correspond
    to the E instruction [i].
@@ -35,7 +48,28 @@ let rec cfg_node_of_einstr (next: int) (cfg : (int, cfg_node) Hashtbl.t)
     cfg_expr_of_eexpr e >>= fun e ->
     Hashtbl.replace cfg next (Cassign(v,e,succ));
     OK (next, next + 1)
-   | _ -> Error "cfg_node_of_einstr not implemented yet."
+  | Elang.Iif (c, ithen, ielse) ->
+    cfg_expr_of_eexpr c >>= fun c ->
+    cfg_node_of_einstr next cfg succ ithen >>= fun (nthen, next) ->
+    cfg_node_of_einstr next cfg succ ielse  >>= fun (nelse, next) ->
+    Hashtbl.replace cfg next (Ccmp(c, nthen, nelse)); OK (next, next + 1)
+  | Elang.Iwhile (c, i) ->
+    cfg_expr_of_eexpr c >>= fun c ->
+    let (cmp, next) = (next, next+1) in
+    cfg_node_of_einstr next cfg cmp i >>= fun (nthen, next) ->
+    Hashtbl.replace cfg cmp (Ccmp(c, nthen, succ)); OK (cmp, next + 1)
+  | Elang.Iblock il ->
+    List.fold_right (fun i acc ->
+        acc >>= fun (succ, next) ->
+        cfg_node_of_einstr next cfg succ i
+      ) il (OK (succ, next))
+  | 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)
 
 (* Some nodes may be unreachable after the CFG is entirely generated. The
    [reachable_nodes n cfg] constructs the set of node identifiers that are
@@ -72,4 +106,13 @@ let cfg_gdef_of_edef gd =
     Gfun f -> cfg_fun_of_efun f >>= fun f -> OK (Gfun f)
 
 let cfg_prog_of_eprog (ep: eprog) : cfg_fun prog res =
-  assoc_map_res (fun fname -> cfg_gdef_of_edef) ep
+  assoc_map_res (fun _ -> cfg_gdef_of_edef) ep
+
+let pass_cfg_gen ep =
+  match cfg_prog_of_eprog ep with
+  | Error msg ->
+    record_compile_result ~error:(Some msg) "CFG"; Error msg
+  | OK cfg ->
+    record_compile_result "CFG";
+    dump !cfg_dump dump_cfg_prog cfg (call_dot "cfg" "CFG");
+    OK cfg

src/cfg_liveness.ml

+open Batteries
+open Cfg
+
+(* Analyse de vivacité *)
+
+(* [vars_in_expr e] renvoie l'ensemble des variables qui apparaissent dans [e]. *)
+let rec vars_in_expr (e: expr) =
+   (* TODO *)
+   Set.empty
+
+(* [live_after_node cfg n] renvoie l'ensemble des variables vivantes après le
+   nœud [n] dans un CFG [cfg]. [lives] est l'état courant de l'analyse,
+   c'est-à-dire une table dont les clés sont des identifiants de nœuds du CFG et
+   les valeurs sont les ensembles de variables vivantes avant chaque nœud. *)
+let live_after_node cfg n (lives: (int, string Set.t) Hashtbl.t) : string Set.t =
+   (* TODO *)
+   Set.empty
+
+(* [live_cfg_node node live_after] renvoie l'ensemble des variables vivantes
+   avant un nœud [node], étant donné l'ensemble [live_after] des variables
+   vivantes après ce nœud. *)
+let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
+   (* TODO *)
+   live_after
+
+(* [live_cfg_nodes cfg lives] effectue une itération du calcul de point fixe.
+
+   Cette fonction met à jour l'état de l'analyse [lives] et renvoie un booléen
+   qui indique si le calcul a progressé durant cette itération (i.e. s'il existe
+   au moins un nœud n pour lequel l'ensemble des variables vivantes avant ce
+   nœud a changé). *)
+let live_cfg_nodes cfg (lives : (int, string Set.t) Hashtbl.t) =
+   (* TODO *)
+   false
+
+(* [live_cfg_fun f] calcule l'ensemble des variables vivantes avant chaque nœud
+   du CFG en itérant [live_cfg_nodes] jusqu'à ce qu'un point fixe soit atteint.
+   *)
+let live_cfg_fun (f: cfg_fun) : (int, string Set.t) Hashtbl.t =
+  let lives = Hashtbl.create 17 in
+     (* TODO *)
+ lives

src/cfg_nop_elim.ml

@@ -3,65 +3,76 @@ open Batteries
 open Prog
 open Utils
 open Cfg
+open Report
+open Cfg_print
+open Options
 
-(* [nop_transitions cfg] gives the list of NOP transitions in the CFG.
+(* Élimination des NOPs. *)
 
-   If node n is [Cnop s], then [(n,s)] should be in the result list.
+(* [nop_transitions cfg] donne la liste des transitions NOP dans un CFG.
+
+   Si le nœud [n] contient [Cnop s], alors [(n,s)] devrait être dans le résultat.
 *)
 let nop_transitions (cfgfunbody: (int, cfg_node) Hashtbl.t) : (int * int) list =
    (* TODO *)
    []
 
 
-(* [follow n l visited] gives the first non-nop successor of [n], according to
-   the successor relation encoded in list [l]. [(x,y)] in [l] means there is a
-   NOP-transition from node [x] to node [y].
+(* [follow n l visited] donne le premier successeur à partir de [n] qui ne soit
+   pas un NOP. Pour connaître le successeur d'un nœud NOP, on utilisara la liste
+   [l] telle que produite précédemment. Pour rappel [(x,y)] dans [l] signifie
+   qu'il y a un transition depuis un nœud [x] qui contient une instruction [Cnop
+   y].
 
-   The set [visited] is used to make sure we don't fall into an infinite loop.
-*)
+   L'ensemble [visited] est utilisé pour éviter les boucles.
+   *)
 let rec follow (n: int) (l: (int * int) list) (visited: int Set.t) : int =
    (* TODO *)
    n
 
-(* [nop_transitions_closed] contains the list [(n,s)] of nodes [n] such that the
-   instruction at node [n] is the beginning of a NOP-chain ending in node [s]. *)
+(* [nop_transitions_closed] contient la liste [(n,s)] telle que l'instruction au
+   nœud [n] est le début d'une chaîne de NOPs qui termine au nœud [s]. Les
+   enseignants du cours de compiilation sont heureux de vous offrir cette
+   fonction. *)
 let nop_transitions_closed cfgfunbody =
   List.map (fun (node_id, node) ->
       (node_id, follow node_id (nop_transitions cfgfunbody) Set.empty))
     (nop_transitions cfgfunbody)
 
+(* Nous allons maintenant réécrire notre programme pour remplacer les
+   successeurs [s] de chaque nœud du CFG de la manière suivante : si [s] est le
+   début d'une chaîne de NOPs, on remplace [s] par la fin de cette chaîne, en
+   éliminant ainsi les nœuds NOPs. *)
 
-
-(* [preds n] gives the list of predecessors of a node [n]. *)
-let preds cfgfunbody n =
-  Hashtbl.fold (fun m m' acc ->
-      match m' with
-      | Cfg.Cassign (_, _, s)
-      | Cfg.Cprint (_, s)
-      | Cfg.Cnop s -> if s = n then Set.add m acc else acc
-      | Cfg.Creturn _ -> acc
-      | Cfg.Ccmp (_, s1, s2) -> if s1 = n || s2 = n then Set.add m acc else acc
-    ) cfgfunbody Set.empty
-
-(* [replace_succ nop_succs s] gives the new name for node [s], after applying
-   nop-transitions. *)
+(* [replace_succ nop_succs s] donne le nouveau nom du nœud [s], en utilisant la
+   liste [nop_succs] (telle que renvoyée par [nop_transitions_closed]). *)
 let replace_succ nop_succs s =
-  match List.assoc_opt s nop_succs with
-    None -> s
-  | Some t -> t
+   (* TODO *)
+   s
 
-(* [replace_succs nop_succs n] replaces the old CFG node names in node [n]
-   with the new ones, according to [nop_succs]. *)
+(* [replace_succs nop_succs n] remplace le nœud [n] par un nœud équivalent où on
+   a remplacé les successeurs, en utilisant la liste [nop_succs]. *)
 let replace_succs nop_succs (n: cfg_node) =
    (* TODO *)
    n
 
-(* [nop_elim_fun f] transforms CFG function [f] by eliminating NOP instructions *)
+(* [nop_elim_fun f] applique la fonction [replace_succs] à chaque nœud du CFG. *)
 let nop_elim_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
   let nop_transf = nop_transitions_closed cfgfunbody in
+  (* On utilise la fonction [Hashtbl.filter_map f h] qui permet d'appliquer une
+     fonction à chaque nœud de [h] et d'éliminer ceux pour lesquels [f] renvoie
+     [None].
+
+     On souhaite éliminer les nœuds qui n'ont pas de prédécesseurs
+     (inaccessibles), et appliquer la fonction [replace_succs] aux nœuds qui
+     resteront.
+  *)
   let cfgfunbody = Hashtbl.filter_map (fun n node ->
+         (* TODO *)
          Some node
     ) cfgfunbody in
+  (* La fonction renvoyée est composée du nouveau [cfgfunbody] que l'on vient de
+     calculer, et le point d'entrée est transformé en conséquence. *)
   {f with cfgfunbody; cfgentry = replace_succ nop_transf cfgentry }
 
 let nop_elim_gdef gd =
@@ -69,4 +80,13 @@ let nop_elim_gdef gd =
     Gfun f -> Gfun (nop_elim_fun f)
 
 let nop_elimination cp =
-  assoc_map nop_elim_gdef cp
+  if !Options.no_cfg_ne
+  then cp
+  else assoc_map nop_elim_gdef cp
+
+let pass_nop_elimination cfg =
+  let cfg = nop_elimination cfg in
+  record_compile_result "NopElim";
+  dump (!cfg_dump >*> fun s -> s ^ "3") dump_cfg_prog cfg
+    (call_dot "cfg-after-nop" "CFG after NOP elim");
+  OK cfg

src/cfg_print.ml

@@ -2,7 +2,6 @@ open Batteries
 open Cfg
 open Elang_print
 open Prog
-open Utils
 
 let rec dump_cfgexpr : expr -> string = function
   | Ebinop(b, e1, e2) -> Format.sprintf "(%s %s %s)" (dump_cfgexpr e1) (dump_binop b) (dump_cfgexpr e2)
@@ -44,7 +43,7 @@ let dump_liveness_state oc ht state =
       flush_all ()
     ) ht
 
-let dump_cfg_fun oc cfgfunname ({ cfgfunargs; cfgfunbody; cfgentry; }: cfg_fun) =
+let dump_cfg_fun oc cfgfunname ({ cfgfunbody; cfgentry; _ }: cfg_fun) =
   Format.fprintf oc "subgraph cluster_%s {\n label=\"%s\";\n" cfgfunname cfgfunname;
   Hashtbl.iter (fun n node ->
       Format.fprintf oc "n_%s_%d [label=\"%a\" xlabel=\"%d\" shape=%s];\n" cfgfunname n dump_cfg_node node n (if n = cfgentry then "rectangle peripheries=2" else "rectangle");

src/cfg_run.ml

@@ -7,7 +7,8 @@ open Cfg
 open Utils
 open Builtins
 
-let rec eval_cfgexpr st : expr -> int res = function
+let rec eval_cfgexpr st (e: expr) : int res =
+  match e with
   | Ebinop(b, e1, e2) ->
     eval_cfgexpr st e1 >>= fun v1 ->
     eval_cfgexpr st e2 >>= fun v2 ->
@@ -52,7 +53,7 @@ let eval_cfgfun oc st cfgfunname { cfgfunargs;
   let st' = { st with env = Hashtbl.create 17 } in
   match List.iter2 (fun a v -> Hashtbl.replace st'.env a v) cfgfunargs vargs with
   | () -> eval_cfginstr oc st' cfgfunbody cfgentry >>= fun (v, st') ->
-    OK (Some v, st')
+    OK (Some v, {st' with env = st.env})
   | exception Invalid_argument _ ->
     Error (Format.sprintf "CFG: Called function %s with %d arguments, expected %d.\n"
              cfgfunname (List.length vargs) (List.length cfgfunargs)