fix errors in nfa_to_dot by catching errors in e_regexp + other stuff

.gitignore

@@ -3,6 +3,7 @@ tests/**/*.cfg
 tests/**/*.cfg0
 tests/**/*.cfg1
 tests/**/*.cfg2
+tests/**/*.cfg3
 tests/**/*.e.dump
 tests/**/*.e.html
 tests/**/*.exe

Makefile

@@ -9,7 +9,7 @@ main.native:
 			-t grammar.html
 	./configure
 	make -C src
-	cp src/main.native main.native
+	ln -sf src/main.native main.native
 
 
 clean:

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 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 utils.ml
+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_loops.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 utils.ml
 
 TG = main.native
 

src/cfg.ml

@@ -26,6 +26,29 @@ type cfg_fun = {
 type cprog = cfg_fun prog
 
 
+(* [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 (Cassign (_, _, s)) -> [s]
+  | Some (Creturn _) -> []
+  | Some (Ccmp (_, s1, s2)) -> [s1;s2]
+  | Some (Cnop s) -> [s]
+
+
+(* [preds n] gives the list of predecessors of a node [n]. *)
+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 b e1 e2 =
   1 + e1 + e2
 
@@ -49,3 +72,22 @@ let rec size_instr (i: cfg_node) : int =
 
 let size_fun f =
   Hashtbl.fold (fun k v acc -> acc + size_instr v) f 0
+
+let fixpoint
+    (transfer: (int, cfg_node) Hashtbl.t -> (int, 'a) Hashtbl.t -> int -> 'a)
+    (init: (int, cfg_node) Hashtbl.t -> int -> cfg_node -> 'a)
+    (cfg: (int, cfg_node) Hashtbl.t) :
+  (int, 'a) Hashtbl.t =
+  let res = Hashtbl.map (fun k v -> init cfg k v) cfg in
+  let iter res =
+    Hashtbl.fold (fun n oldstate changed ->
+        let newstate = transfer cfg res n in
+        Hashtbl.replace res n newstate;
+        changed || not (Set.equal newstate oldstate)
+      ) res false in
+  let rec fix () =
+    if iter res
+    then fix ()
+    else () in
+  fix ();
+  res

src/cfg_dead_assign.ml

@@ -2,54 +2,8 @@ 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
-
+open Cfg_liveness
+    
 (* Dead Assign Elimination *)
 
 (* [dead_assign_elimination_fun f] performs DAE on function [f]. *)

src/cfg_liveness.ml

+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
+
+(* 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
+
+let live_cfg_fun ({ cfgfunargs; cfgfunbody; cfgentry }: cfg_fun) =
+  fixpoint (fun cfg lives n ->
+      match Hashtbl.find_option cfg n with
+      | Some cn -> live_cfg_node cn (live_after_node cfg n lives)
+      | None -> failwith "Unknown node"
+    )
+    (fun cfg n cn -> Set.empty)
+    cfgfunbody

src/cfg_loops.ml

+open Batteries
+open Elang
+open Cfg_gen
+open Cfg_print
+open Cfg_liveness
+open Cfg
+open Utils
+open Prog
+
+
+let optimize_loop_cfg cfg = cfg

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 ->

src/e_regexp.ml

@@ -108,7 +108,11 @@ let list_regexp =
     (Cat (char_regexp '\'',
           Cat (char_range (List.filter (fun c -> c <> '\'' && c <> '\\') alphabet),
                char_regexp '\'')),
-     fun s -> Some (SYM_CHARACTER (String.get s 1)));
+     fun s ->
+       match String.get s 1 with
+       | a -> Some (SYM_CHARACTER a)
+       | exception Invalid_argument _ -> Some (SYM_CHARACTER '\x00')
+    );
     (Cat (char_regexp '\'', Cat (char_regexp '\\',
           Cat (char_range (char_list_of_string "\\tn0"),
                char_regexp '\''))),
@@ -118,6 +122,7 @@ let list_regexp =
          | 't' -> Some (SYM_CHARACTER '\t')
          | '0' -> Some (SYM_CHARACTER '\x00')
          | _ -> None
+         | exception _ -> Some (SYM_CHARACTER '\x00')
     );
     (Cat (char_regexp '"',
           Cat (Star (

src/main.ml

@@ -36,6 +36,8 @@ open Report
 open Options
 open Lexer_generator
 
+open Cfg_loops
+
 let tokenize file =
   Lexer_generator.tokenize_file file >>= fun tokens ->
   OK (List.map (fun tok -> (tok, None)) tokens)
@@ -49,6 +51,7 @@ let speclist =
     ("-e-run", Arg.Set e_run, "Run Elang program.");
     ("-cfg-dump", Arg.String (fun s -> cfg_dump := Some s), "Output CFG file.");
     ("-cfg-run", Arg.Set cfg_run, "Run CFG program.");
+    ("-cfg-run-after-loop", Arg.Set cfg_run_after_loop, "Run CFG program after loop optimization.");
     ("-cfg-run-after-cp", Arg.Set cfg_run_after_cp, "Run CFG program after constant propagation.");
     ("-cfg-run-after-dae", Arg.Set cfg_run_after_dae, "Run CFG program after dead assign elimination.");
     ("-cfg-run-after-ne", Arg.Set cfg_run_after_ne, "Run CFG program after nop elimination.");
@@ -67,6 +70,7 @@ let speclist =
     ("-all-run", Arg.Unit (fun () ->
          e_run := true;
          cfg_run := true;
+         cfg_run_after_loop := true;
          cfg_run_after_cp := true;
          cfg_run_after_dae := true;
          cfg_run_after_ne := true;
@@ -289,27 +293,37 @@ let _ =
             run "Elang" !e_run eval_eprog ep;
 
             cfg_prog_of_eprog ep >>! fun cfg ->
+            record_compile_result ~data:([(`Assoc (List.map (fun (fname,Prog.Gfun cfgfun) -> (fname, `Int (Cfg.size_fun cfgfun.cfgfunbody))) cfg))]) "CFG";
+
             dump !cfg_dump dump_cfg_prog cfg (call_dot "cfg" "CFG");
             run "CFG" !cfg_run eval_cfgprog cfg;
 
-            let cfg = constant_propagation cfg in
-            record_compile_result "ConstProp";
+            let cfg = optimize_loop_cfg cfg in
+            record_compile_result ~data:([(`Assoc (List.map (fun (fname,Prog.Gfun cfgfun) -> (fname, `Int (Cfg.size_fun cfgfun.cfgfunbody))) cfg))]) "CFG loops";
             dump (!cfg_dump >*> fun s -> s ^ "0") dump_cfg_prog cfg
+              (call_dot "cfg-after-loop" "CFG after loop optim");
+            run "CFG after loop optim" !cfg_run_after_loop eval_cfgprog cfg;
+
+
+            let cfg = constant_propagation cfg in
+            record_compile_result ~data:([(`Assoc (List.map (fun (fname,Prog.Gfun cfgfun) -> (fname, `Int (Cfg.size_fun cfgfun.cfgfunbody))) cfg))]) "Constprop";
+            dump (!cfg_dump >*> fun s -> s ^ "1") dump_cfg_prog cfg
               (call_dot "cfg-after-cstprop" "CFG after Constant Propagation");
             run "CFG after constant_propagation" !cfg_run_after_cp eval_cfgprog cfg;
 
             let cfg = dead_assign_elimination cfg in
-            record_compile_result "DeadAssign";
-            dump (!cfg_dump >*> fun s -> s ^ "1") dump_cfg_prog cfg
+            record_compile_result ~data:([(`Assoc (List.map (fun (fname,Prog.Gfun cfgfun) -> (fname, `Int (Cfg.size_fun cfgfun.cfgfunbody))) cfg))]) "DeadAssign";
+            dump (!cfg_dump >*> fun s -> s ^ "2") dump_cfg_prog cfg
               (call_dot "cfg-after-dae" "CFG after DAE");
             run "CFG after dead_assign_elimination" !cfg_run_after_dae eval_cfgprog cfg;
 
             let cfg = nop_elimination cfg in
-            record_compile_result "NopElim";
-            dump (!cfg_dump >*> fun s -> s ^ "2") dump_cfg_prog cfg
+            record_compile_result ~data:([(`Assoc (List.map (fun (fname,Prog.Gfun cfgfun) -> (fname, `Int (Cfg.size_fun cfgfun.cfgfunbody))) cfg))]) "NopElim";
+            dump (!cfg_dump >*> fun s -> s ^ "3") dump_cfg_prog cfg
               (call_dot "cfg-after-nop" "CFG after NOP elim");
             run "CFG after nop_elimination" !cfg_run_after_ne eval_cfgprog cfg;
 
+
             let rtl = rtl_of_cfg cfg in
             dump !rtl_dump dump_rtl_prog rtl
               (fun file () -> add_to_report "rtl" "RTL" (Code (file_contents file)));

src/options.ml

@@ -7,6 +7,7 @@ let e_dump : string option ref = ref None
 let e_run = ref false
 let cfg_dump : string option ref = ref None
 let cfg_run = ref false
+let cfg_run_after_loop = ref false
 let cfg_run_after_cp = ref false
 let cfg_run_after_dae = ref false
 let cfg_run_after_ne = ref false

src/utils.ml

@@ -276,4 +276,13 @@ let string_of_int_list l =
 let string_of_int_set s =
   string_of_int_list (Set.to_list s)
 
+let string_of_string_set v =
+  String.concat ", " (Set.to_list v)
 
+let string_of_int_int_set v =
+  String.concat ", " (List.map (fun (x,y) -> Printf.sprintf "(%d,%d)" x y) (Set.to_list v))
+
+let string_of_int_option v =
+  match v with
+  | None -> "undef"
+  | Some x -> string_of_int x

tests/basic/loop.e

+main(){
+  i = 10;
+  a = 2;
+  res = 0;
+  while(i > 0){
+    x = a + a;
+    if(a > 4){
+      res = res + x;
+    } else {
+      res = res - x;
+    }
+    i = i - 1;
+  }
+  return res;
+}

tests/basic/loop.e.expect_14_12_3_8_12

+{"output": "", "error": null, "retval": -40}
\ No newline at end of file

tests/basic/loop.e.expect_1_2_3

+{"output": "", "error": null, "retval": -40}
\ No newline at end of file

tests/basic/loop2.e

+main(){
+  i = 20;
+  while(i > 0){
+    if(i < 5){
+      a = 5;
+    } else {
+      a = 6;
+    }
+    i = i - 1;
+  }
+  return i;
+}

tests/basic/loop2.e.expect_14_12_3_8_12

+{"output": "", "error": null, "retval": 0}
\ No newline at end of file

tests/basic/loop2.e.expect_1_2_3

+{"output": "", "error": null, "retval": 0}
\ No newline at end of file

tests/basic/loop3.e

+main(){
+  i = 20;
+  c = 8;
+  a = 5;
+  b = 0;
+  while(i > 0){
+    if(i < 5){
+      a = 4 + c;
+    }
+    b = b + a;
+    i = i - 1;
+  }
+  return b;
+}