Merge branch 'main' into dsl+artifact

dsl/frontend/policy.ml

@@ -8,40 +8,41 @@ type t =
 
 exception UnboundVariable of Ast.var
 exception UndeclaredClass of Ast.clss
+exception DuplicateClass of Ast.clss
 
 let lookup s x =
   match List.assoc_opt x s with
   | Some v -> v
   | None -> raise (UnboundVariable x)
 
-let rec sub cl st (p : Ast.policy) =
-  (* Helper function that evaluates a policy list. *)
-  let sub_plst cl st = List.map (sub cl st) in
-
-  (* Helper function that evaluates a weighted policy list. *)
-  let sub_weighted_plst cl st = List.map (fun (x, i) -> (sub cl st x, i)) 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 cl then Class c else raise (UndeclaredClass c)
-  | Var x -> sub cl st (lookup st x)
+  | Class c ->
+      if List.mem c !used then raise (DuplicateClass c)
+      else if List.mem c cl then (
+        used := c :: !used;
+        (Class c : t))
+      else raise (UndeclaredClass c)
+  | Var x -> sub cl st (lookup st x) 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 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) = sub cl alst ret
+let of_program (cl, alst, ret) : t = sub cl alst ret (ref [])
 
 let rec to_string p =
   let sprintf = Printf.sprintf in
-
-  (* Helper function to compactly join policy lists by comma *)
   let join lst =
     sprintf "[%s]" (lst |> List.map to_string |> String.concat ", ")
   in
-
-  (* Helper function to compactly join weighted policy lists by comma *)
   let join_weighted lst =
     sprintf "[%s]"
       (lst

dsl/frontend/policy.mli

@@ -8,6 +8,7 @@ type t =
 
 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

dsl/tests/parsing.ml

@@ -62,6 +62,10 @@ let error_tests =
     make_error_test "unbound var in middle of list of assignments"
       "progs/incorrect/unbound_var_hier.sched"
       (Policy.UnboundVariable "r_polic");
+    make_error_test "class used twice in policy"
+      "progs/incorrect/duplicate_classes.sched" (Policy.DuplicateClass "B");
+    make_error_test "class used twice in one fifo"
+      "progs/incorrect/duplicate_samepol.sched" (Policy.DuplicateClass "A");
   ]
 
 let suite = "parsing tests" >::: wc_tests @ error_tests (* @ nwc_tests *)

progs/incorrect/duplicate_classes.sched

@@ -0,0 +1,6 @@
+classes A, B; 
+
+var = rr[A, B];
+final = fifo[var, B]; // B is used twice
+
+return final

progs/incorrect/duplicate_samepol.sched

@@ -0,0 +1,5 @@
+classes A, B;
+
+x = fifo[A, A];
+
+return x

progs/incorrect/unused_variable.sched

@@ -0,0 +1,7 @@
+classes A, B, C;
+
+pol_1 = rr[A, B];
+pol_2 = rr[B, C];
+ans = strict[pol_1, C];
+
+return ans