Several reversions

rio/frontend/policy.ml

@@ -1,16 +1,10 @@
 (* Changes to this type must also be reflected in `Ast.policy` in ast.ml *)
-type set =
-  | Class of Ast.clss
-  | Union of set list
-
 type t =
-  | Fifo of set
-  | EarliestDeadline of set
-  | ShortestJobNext of set
-  | ShortestRemaining of set
+  | Class of Ast.clss
+  | Fifo of t list
   | RoundRobin of t list
   | Strict of t list
-  | WeightedFair of t list * int list
+  | WeightedFair of (t * float) list
 
 exception UnboundVariable of Ast.var
 exception UndeclaredClass of Ast.clss
@@ -21,56 +15,44 @@ let lookup s x =
   | Some v -> v
   | None -> raise (UnboundVariable x)
 
-let rec sub_set cl (p : Ast.set) used : set =
-  let sub_slst = List.map (fun x -> sub_set cl x used) in
+let rec sub cl st (p : Ast.policy) used =
+  let sub_plst cl st = List.map (fun x -> sub cl st x used) in
+  let sub_weighted_plst cl st =
+    List.map (fun (x, i) -> (sub cl st x used, i))
+  in
 
   match p with
   | Class c ->
       if List.mem c !used then raise (DuplicateClass c)
       else if List.mem c cl then (
         used := c :: !used;
-        (Class c : set))
+        (Class c : t))
       else raise (UndeclaredClass c)
-  | Union clst -> Union (sub_slst clst)
-
-let rec sub cl st (p : Ast.policy) used =
-  let sub_plst cl st = List.map (fun x -> sub cl st x used) in
-
-  match p with
   | Var x -> sub cl st (lookup st x) used
-  | Fifo set -> Fifo (sub_set cl set used)
-  | EarliestDeadline set -> EarliestDeadline (sub_set cl set used)
-  | ShortestJobNext set -> ShortestJobNext (sub_set cl set used)
-  | ShortestRemaining set -> ShortestRemaining (sub_set cl set used)
+  | Fifo plst -> Fifo (sub_plst cl st plst)
   | RoundRobin plst -> RoundRobin (sub_plst cl st plst)
   | Strict plst -> Strict (sub_plst cl st plst)
-  | WeightedFair (plst, wts) -> WeightedFair (sub_plst cl st plst, wts)
+  | WeightedFair wplst -> WeightedFair (sub_weighted_plst cl st wplst)
   | _ -> failwith "ERROR: unsupported policy"
 
 (* Look up any variables and substitute them in. *)
 let of_program (cl, alst, ret) : t = sub cl alst ret (ref [])
 
-let rec set_to_string p =
-  let sprintf = Printf.sprintf in
-  match p with
-  | Class c -> c
-  | Union lst ->
-      sprintf "union[%s]" (lst |> List.map set_to_string |> String.concat ",")
-
 let rec to_string p =
   let sprintf = Printf.sprintf in
   let join lst =
     sprintf "[%s]" (lst |> List.map to_string |> String.concat ", ")
   in
-  let join_ints lst =
-    sprintf "[%s]" (lst |> List.map string_of_int |> String.concat ", ")
+  let join_weighted lst =
+    sprintf "[%s]"
+      (lst
+      |> List.map (fun (x, y) -> sprintf "(%s, %.2f)" (to_string x) y)
+      |> String.concat ", ")
   in
 
   match p with
-  | Fifo set -> sprintf "fifo%s" (set_to_string set)
-  | EarliestDeadline set -> sprintf "edf%s" (set_to_string set)
-  | ShortestJobNext set -> sprintf "sjn%s" (set_to_string set)
-  | ShortestRemaining set -> sprintf "fifo%s" (set_to_string set)
+  | Class c -> c
+  | Fifo lst -> sprintf "fifo%s" (join lst)
   | RoundRobin lst -> sprintf "rr%s" (join lst)
   | Strict lst -> sprintf "strict%s" (join lst)
-  | WeightedFair (lst, wts) -> sprintf "wfq%s %s" (join lst) (join_ints wts)
+  | WeightedFair lst -> sprintf "wfq%s" (join_weighted lst)

rio/frontend/policy.mli

@@ -1,17 +1,10 @@
 (* Changes to this type must also be reflected in `Ast.policy` in ast.ml *)
-
-type set =
-  | Class of Ast.clss
-  | Union of set list
-
 type t =
-  | Fifo of set
-  | EarliestDeadline of set
-  | ShortestJobNext of set
-  | ShortestRemaining of set
+  | Class of Ast.clss
+  | Fifo of t list
   | RoundRobin of t list
   | Strict of t list
-  | WeightedFair of t list * int list
+  | WeightedFair of (t * float) list
 
 exception UnboundVariable of Ast.var
 exception UndeclaredClass of Ast.clss

rio/simulator/state.mli

@@ -4,7 +4,7 @@ exception UnboundKey of string
 
 val empty : t
 val rebind : string -> float -> t -> t
-val rebind_all : (string * 'a) list -> t -> t
+val rebind_all : (string * float) list -> t -> t
 val is_defined : string -> t -> bool
 val lookup : string -> t -> float
 val lookup_opt : string -> t -> float option

rio/simulator/topo.ml

@@ -14,10 +14,9 @@ let rec addr_to_string = function
 
 let rec of_policy (p : Frontend.Policy.t) =
   match p with
-  | Fifo _ | EarliestDeadline _ | ShortestJobNext _ | ShortestRemaining _ ->
-      Node [ Star ]
-  | RoundRobin plst | Strict plst -> Node (List.map of_policy plst)
-  | WeightedFair (wplst, _) -> Node (List.map of_policy wplst)
+  | Class _ -> Star
+  | Fifo plst | RoundRobin plst | Strict plst -> Node (List.map of_policy plst)
+  | WeightedFair wplst -> Node (List.map (fun (p, _) -> of_policy p) wplst)
 
 let rec height = function
   | Star -> 1