Undo Frontend.Policy changes

- add missing FIFOs to tests

Author: polybeandip

rio/frontend/ast.ml

@@ -24,8 +24,4 @@ type stream =
   (* Variables *)
   | Var of var
 
-type policy = stream
-type declare = clss list
-type assignment = var * policy
-type return = policy
-type program = declare * assignment list * return
+type program = clss list * (var * stream) list * stream

rio/frontend/parser.mly

@@ -10,8 +10,8 @@
 
     type internalcomp =
     | DeclareComp of clss list
-    | AssnComp of var * policy
-    | RtnComp of policy
+    | AssnComp of var * stream
+    | RtnComp of stream
 
     (* Check that a program contains exactly one return statement as its final component *)
     let rec validate_seq acc = function

rio/frontend/policy.ml

@@ -1,43 +1,51 @@
-type set2stream = EDF | FIFO
-type stream2stream = RR | Strict
-
 type t =
-  | Leaf of (set2stream * Ast.clss list)
-  | Node of (stream2stream * t list)
+  | Fifo of Ast.clss list
+  | EDF of Ast.clss list
+  | RoundRobin of t list
+  | Strict of t list
 
 exception UnboundVariable of Ast.var
 exception UndeclaredClass of Ast.clss
 exception DuplicateClass of Ast.clss
 
 let rec lookup x = function
-  | (a, b) :: t when a = x -> b, t
-  | _ :: t -> lookup x t
   | [] -> raise (UnboundVariable x)
-
-
-let rec sub cl st (p : Ast.policy) used =
-  let rec sub_set cl (s : Ast.set) =
-    match s with
-    | Union ss -> ss |> List.map (sub_set cl) |> List.flatten
-    | Class c ->
-        if List.mem c !used then 
-          raise (DuplicateClass c)
-        else if not (List.mem c cl) then 
-          raise (UndeclaredClass c)
-        else 
-          (used := c :: !used; [ c ])
+  | (v, p) :: t when v = x -> (p, t)
+  | (_, _) :: t -> lookup x t
+
+let rec sub cl st used (p : Ast.stream) =
+  let sub_ps = List.map (sub cl st used) in
+  let rec sub_set = function
+    | Ast.Class c ->
+        if List.mem c !used then raise (DuplicateClass c)
+        else if not (List.mem c cl) then raise (UndeclaredClass c)
+        else (
+          used := c :: !used;
+          [ c ])
+    | Ast.Union sets -> sets |> List.map sub_set |> List.flatten
   in
-  let sub_ps cl st = List.map (fun x -> sub cl st x used) in
 
   match p with
-  | Var x -> let v, t = (lookup x st) in sub cl t v used
-  | Fifo s -> Leaf (FIFO, sub_set cl s)
-  | EarliestDeadline s -> Leaf (EDF, sub_set cl s)
-  | RoundRobin ps -> Node (RR, sub_ps cl st ps)
-  | Strict ps -> Node (Strict, sub_ps cl st ps)
+  | Var x ->
+      let p, st = lookup x st in
+      sub cl st used p
+  | Fifo s -> Fifo (sub_set s)
+  | EarliestDeadline s -> EDF (sub_set s)
+  | RoundRobin ps -> RoundRobin (sub_ps ps)
+  | Strict ps -> Strict (sub_ps ps)
   | _ -> failwith "ERROR: unsupported policy"
 
 (* Look up any variables and substitute them in. *)
-let of_program (cl, alst, ret) = sub cl alst ret (ref [])
+let of_program (classes, assigns, ret) = sub classes assigns (ref []) ret
 
-let to_string _ = "NOT COMPLETE YET! SORRY"
+let rec to_string p =
+  let fmt = Printf.sprintf in
+  let join lst to_string = lst |> List.map to_string |> String.concat ", " in
+
+  match p with
+  | Fifo cs when List.length cs > 1 -> fmt "fifo[union[%s]]" (join cs Fun.id)
+  | EDF cs when List.length cs > 1 -> fmt "edf[union[%s]]" (join cs Fun.id)
+  | Fifo cs -> fmt "fifo[%s]" (join cs Fun.id)
+  | EDF cs -> fmt "edf[%s]" (join cs Fun.id)
+  | RoundRobin ps -> fmt "rr[%s]" (join ps to_string)
+  | Strict ps -> fmt "strict[%s]" (join ps to_string)

rio/frontend/policy.mli

@@ -1,13 +1,12 @@
-type set2stream = EDF | FIFO
-type stream2stream = RR | Strict
-
 type t =
-  | Leaf of (set2stream * Ast.clss list)
-  | Node of (stream2stream * t list)
+  | Fifo of Ast.clss list
+  | EDF of Ast.clss list
+  | RoundRobin of t list
+  | Strict of t list
 
 exception UnboundVariable of Ast.var
 exception UndeclaredClass of Ast.clss
 exception DuplicateClass of Ast.clss
 
 val of_program : Ast.program -> t
-val to_string : t -> string
+val to_string : t -> string

rio/tests/frontend/dunee rio/tests/frontend/dunerio/tests/frontend/dunee renamed to rio/tests/frontend/dune

@@ -1,3 +1,3 @@
 (tests
- (names ttest_parsing)
+ (names test_parsing)
  (libraries rio.frontend ounit2))

rio/tests/frontend/test_parsing.mll rio/tests/frontend/test_parsing.mlrio/tests/frontend/test_parsing.mll renamed to rio/tests/frontend/test_parsing.ml

@@ -1,7 +1,7 @@
 open Frontend
 open OUnit2
 
-let prefix = "../../../../"
+let prefix = "../../../../../"
 let parse filename = prefix ^ filename |> Parser.parse_file |> Policy.of_program
 
 let make_test name filename val_str =
@@ -20,26 +20,27 @@ let wc_tests =
     make_test "fifo 1 class" "progs/work_conserving/fifo_1_class.sched"
       "fifo[A]";
     make_test "fifo of 3" "progs/work_conserving/fifo_n_classes.sched"
-      "fifo[A, B, C]";
-    make_test "rr of 1" "progs/work_conserving/rr_1_class.sched" "rr[A]";
+      "fifo[union[A, B, C]]";
+    make_test "rr of 1" "progs/work_conserving/rr_1_class.sched" "rr[fifo[A]]";
     make_test "rr of 2" "progs/work_conserving/rr_2_classes.sched"
-      "rr[fifo[A, B]]";
+      "rr[fifo[union[A, B]]]";
     make_test "multiple assignments"
       "progs/work_conserving/rr_hier_merge_sugar.sched"
-      "rr[fifo[BX, BY], rr[RP, RT]]";
+      "rr[fifo[union[BX, BY]], rr[fifo[RP], fifo[RT]]]";
     make_test "2 assignments w/ substitutions"
-      "progs/work_conserving/rr_hier.sched" "rr[B, rr[RP, RT]]";
+      "progs/work_conserving/rr_hier.sched"
+      "rr[fifo[B], rr[fifo[RP], fifo[RT]]]";
     make_test "3 classes with substitutions"
       "progs/work_conserving/rr_n_class_hier.sched"
-      "rr[A, B, rr[rr[CU, CV], rr[CW, CX]]]";
-    make_test "rr of 3" "progs/work_conserving/rr_n_classes.sched" "rr[A, B, C]";
+      "rr[fifo[A], fifo[B], rr[rr[fifo[CU], fifo[CV]], rr[fifo[CW], fifo[CX]]]]";
+    make_test "rr of 3" "progs/work_conserving/rr_n_classes.sched"
+      "rr[fifo[A], fifo[B], fifo[C]]";
     make_test "rr and strict substitutions"
       "progs/work_conserving/rr_strict_n_classes_hier.sched"
-      "strict[A, B, rr[rr[CU, CV], strict[CW, CX]]]";
+      "strict[fifo[A], fifo[B], rr[rr[fifo[CU], fifo[CV]], strict[fifo[CW], \
+       fifo[CX]]]]";
     make_test "strict of 3" "progs/work_conserving/strict_n_classes.sched"
-      "strict[C, B, A]";
-    make_test "wfq of 3" "progs/work_conserving/wfq_n_classes.sched"
-      "wfq[(A, 1.00), (B, 2.00), (C, 3.00)]";
+      "strict[fifo[C], fifo[B], fifo[A]]";
   ]
 
 let _nwc_tests =

rio/tests/simulator/test_rio_tree.ml

@@ -64,7 +64,7 @@ let make_push_pop_test name data tree order permutation =
 let basic_tests =
   let topo = Topo.Node [ CStar A; CStar B ] in
   let tree = Riotree.create topo (fun i -> infer_flow (i mod 2)) in
-  let order = Ordtree.Order [ (Foot, rank); (Foot, rank) ] in
+  let order = Riotree.Order [ (Foot, rank); (Foot, rank) ] in
 
   [
     ( "`pop` on newly created tree is `None`" >:: fun _ ->
@@ -78,7 +78,7 @@ let basic_tests =
 (* Leaf Tests *)
 let leaf_tests =
   let tree = Riotree.create (Topo.CStar A) (fun _ -> A) in
-  let order = Ordtree.Foot in
+  let order = Riotree.Foot in
   let zero_to_nine = consecutive 0 9 in
 
   [
@@ -103,9 +103,9 @@ let ff_ord, fl_ord, weird_ord =
   let one_level_ord l =
     let order =
       l |> List.map float_of_int
-      |> List.map (fun r -> (Ordtree.Foot, Rank.create r))
+      |> List.map (fun r -> (Riotree.Foot, Rank.create r))
     in
-    Ordtree.Order order
+    Riotree.Order order
   in
   (one_level_ord ff, one_level_ord fl, one_level_ord weird)
 
@@ -151,17 +151,17 @@ let tree = Riotree.create topo infer_flow
 
 let ff_ord, fl_ord =
   let ff_small_ord, fl_small_ord =
-    ( Ordtree.Order [ (Foot, Rank.create 0.0); (Foot, Rank.create 1.0) ],
-      Ordtree.Order [ (Foot, Rank.create 1.0); (Foot, Rank.create 0.0) ] )
+    ( Riotree.Order [ (Foot, Rank.create 0.0); (Foot, Rank.create 1.0) ],
+      Riotree.Order [ (Foot, Rank.create 1.0); (Foot, Rank.create 0.0) ] )
   in
-  ( Ordtree.Order
+  ( Riotree.Order
       [
         (ff_small_ord, Rank.create 0.0);
         (Foot, Rank.create 1.0);
         (Foot, Rank.create 2.0);
         (ff_small_ord, Rank.create 3.0);
       ],
-    Ordtree.Order
+    Riotree.Order
       [
         (fl_small_ord, Rank.create 3.0);
         (Foot, Rank.create 2.0);