Propagated new AST structure to parser and policy checker

rio/frontend/ast.ml

@@ -8,14 +8,14 @@ type set =
 
 type stream =
   (* Set-to-Stream *)
-  | Fifo of set list
-  | EarliestDeadline of set list
-  | ShortestJobNext of set list
-  | ShortestRemaining of set list
+  | Fifo of set
+  | EarliestDeadline of set
+  | ShortestJobNext of set
+  | ShortestRemaining of set
   (* Stream-To-Stream *)
   | RoundRobin of stream list
   | Strict of stream list
-  | WeightedFair of (stream * float) list
+  | WeightedFair of stream list * int list
   (* Non-Work Conserving *)
   | RateControlled of stream list
   | LeakyBucket of stream list * int * int
@@ -24,7 +24,8 @@ type stream =
   (* Variables *)
   | Var of var
 
+type policy = stream
 type declare = clss list
-type assignment = var * stream
-type return = stream
+type assignment = var * policy
+type return = policy
 type program = declare * assignment list * return

rio/frontend/lexer.mll

@@ -16,8 +16,6 @@ rule token = parse
 | "="                   { EQUALS }
 | "["                   { LBRACKET }
 | "]"                   { RBRACKET }
-| "("                   { LPAREN }
-| ")"                   { RPAREN }
 | "return"              { RETURN }
 | "classes"             { CLASSES }
 | "union"               { UNION }
@@ -41,7 +39,6 @@ rule token = parse
 | id as v               { VAR(v) }
 | bigid as i            { CLSS(i) }
 | int                   { INT (int_of_string (Lexing.lexeme lexbuf)) }
-| float                 { FLOAT (float_of_string (Lexing.lexeme lexbuf)) }
 | eof                   { EOF }
 
 

rio/frontend/parser.mly

@@ -34,13 +34,10 @@
 
 %token <string> VAR
 %token <string> CLSS
-%token <float> FLOAT
 %token <int> INT
 %token EQUALS
 %token LBRACKET
 %token RBRACKET
-%token LPAREN
-%token RPAREN
 %token RETURN
 %token CLASSES
 %token UNION
@@ -68,17 +65,20 @@
 
 %%
 
+set:
+    | CLSS                                              { Class($1) }
+    | UNION LBRACKET; pl = setlist; RBRACKET            { Union pl }
+
 /* Policies */
 policy:
-    | UNION LBRACKET; pl = arglist; RBRACKET            { Union pl }
-    | FIFO LBRACKET; pl = arglist; RBRACKET             { Fifo pl }
-    | STRICT LBRACKET; pl = arglist; RBRACKET           { Strict pl }
-    | RR LBRACKET; pl = arglist; RBRACKET               { RoundRobin pl }
-    | WFQ LBRACKET; pl = weighted_arglist; RBRACKET     { WeightedFair pl }
-    | EDF LBRACKET; pl = arglist; RBRACKET              { EarliestDeadline pl }
-    | SJN LBRACKET; pl = arglist; RBRACKET              { ShortestJobNext pl }
-    | SRTF LBRACKET; pl = arglist; RBRACKET             { ShortestRemaining pl }
-    | RCSP LBRACKET; pl = arglist; RBRACKET             { RateControlled pl }
+    | FIFO LBRACKET; pl = set; RBRACKET                                              { Fifo pl }
+    | EDF LBRACKET; pl = set; RBRACKET                                               { EarliestDeadline pl }
+    | SJN LBRACKET; pl = set; RBRACKET                                               { ShortestJobNext pl }
+    | SRTF LBRACKET; pl = set; RBRACKET                                              { ShortestRemaining pl }
+    | RR LBRACKET; pl = arglist; RBRACKET                                            { RoundRobin pl }
+    | STRICT LBRACKET; pl = arglist; RBRACKET                                        { Strict pl }
+    | WFQ LBRACKET; pl = arglist; RBRACKET; LBRACKET; wt = weight_list; RBRACKET     { WeightedFair (pl, wt) }
+    | RCSP LBRACKET; pl = arglist; RBRACKET                                          { RateControlled pl }
 
     | LEAKY LBRACKET; LBRACKET;
         pl = arglist; RBRACKET; COMMA;
@@ -94,14 +94,13 @@ policy:
         pl = arglist; RBRACKET; COMMA;
         WIDTH EQUALS; t = INT; RBRACKET                 { StopAndGo (pl, t) }
 
-    | CLSS                                              { Class($1) }
     | VAR                                               { Var($1) }
+setlist:
+    | pl = separated_list(COMMA, set)               { pl }
 arglist:
     | pl = separated_list(COMMA, policy)            { pl }
-weighted_arglist:
-    | pl = separated_list(COMMA, weighted_arg)      { pl }
-weighted_arg:
-    | LPAREN; arg = separated_pair(policy, COMMA, FLOAT); RPAREN      { arg }
+weight_list:
+    | pl = separated_list(COMMA, INT)               { pl }
 
 /* Declarations, assignments and returns */
 internalcomp :

rio/frontend/policy.ml

@@ -1,10 +1,16 @@
 (* Changes to this type must also be reflected in `Ast.policy` in ast.ml *)
-type t =
+type set =
   | Class of Ast.clss
-  | Fifo of t list
+  | Union of set list
+
+type t =
+  | Fifo of set
+  | EarliestDeadline of set
+  | ShortestJobNext of set
+  | ShortestRemaining of set
   | RoundRobin of t list
   | Strict of t list
-  | WeightedFair of (t * float) list
+  | WeightedFair of t list * int list
 
 exception UnboundVariable of Ast.var
 exception UndeclaredClass of Ast.clss
@@ -15,44 +21,56 @@ let lookup s x =
   | Some v -> v
   | None -> raise (UnboundVariable x)
 
-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
+let rec sub_set cl (p : Ast.set) used : set =
+  let sub_slst = List.map (fun x -> sub_set cl x used) 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 : t))
+        (Class c : set))
       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 plst -> Fifo (sub_plst cl st plst)
+  | 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)
   | RoundRobin plst -> RoundRobin (sub_plst cl st plst)
   | Strict plst -> Strict (sub_plst cl st plst)
-  | WeightedFair wplst -> WeightedFair (sub_weighted_plst cl st wplst)
+  | WeightedFair (plst, wts) -> WeightedFair (sub_plst cl st plst, wts)
   | _ -> 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_weighted lst =
-    sprintf "[%s]"
-      (lst
-      |> List.map (fun (x, y) -> sprintf "(%s, %.2f)" (to_string x) y)
-      |> String.concat ", ")
+  let join_ints lst =
+    sprintf "[%s]" (lst |> List.map string_of_int |> String.concat ", ")
   in
 
   match p with
-  | Class c -> c
-  | Fifo lst -> sprintf "fifo%s" (join lst)
+  | 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)
   | RoundRobin lst -> sprintf "rr%s" (join lst)
   | Strict lst -> sprintf "strict%s" (join lst)
-  | WeightedFair lst -> sprintf "wfq%s" (join_weighted lst)
+  | WeightedFair (lst, wts) -> sprintf "wfq%s %s" (join lst) (join_ints wts)

rio/frontend/policy.mli

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