Port Over Simulator and Compiler from pifo-tree-artifact (#57)

This PR makes the following changes
- fill in `ocamlformat`
- remove `bin/`
- alter WFQ to weights to be `float` instead of `int` (necessary to
implement `WFQ_Ternary` in
[`schedulers-in-ocaml`](https://github.com/cucapra/schedulers-in-ocaml/blob/2920e13c9dbc0c22414da326d629970aaabf2624/lib/alg.ml#L191-L195))
- alter file structure to have two libraries, `Frontend` and `Simulate`
- remove NWC policies and `EDF`, `SJN`, and `SRTF` in `policy.ml`;
constructing controls for them is for later
- port over simulator and compiler from `schedulers-in-ocaml`
- implement `Control.of_policy` (**most of the work for this PR**)
- setup T2T compilation tests in `tests/compilation`: i.e. check the
`.csv`s match
- add two work conserving programs: ternary strict and wfq

To generate graphs via our simulator, `cd` into `dsl/` and run
```
dune clean; dune build; dune test; python ../graphs/plot.py
```
This populates `graphs/`

.gitignore

@@ -10,6 +10,7 @@
 *.blg
 
 # OCaml
+_build
 *.annot
 *.cmo
 *.cma
@@ -19,11 +20,6 @@
 *.cmx
 *.cmxs
 *.cmxa
-
-# ocamlbuild working directory
-dsl/_build/
-
-# ocamlbuild targets
 *.byte
 *.native
 
@@ -34,12 +30,16 @@ setup.log
 # Merlin configuring file for Vim and Emacs
 .merlin
 
+# VS code configuring file
+.vscode/
+
 # Dune generated files
 *.install
 
 # local OPAM switch
 _opam/
 .DS_Store
 
-# VS code
-.vscode/
+# misc
+*.png
+*.csv

dsl/.ocamlformat

@@ -0,0 +1,5 @@
+profile = conventional
+break-cases = fit-or-vertical
+exp-grouping = preserve
+parse-docstrings = true
+type-decl = sparse

dsl/dsl.opam

@@ -14,6 +14,11 @@ depends: [
   "dune" {>= "3.16"}
   "ounit2"
   "menhir"
+  "core_kernel"
+  "pcap-format"
+  "hex"
+  "mmap"
+  "csv"
   "odoc" {with-doc}
 ]
 build: [

dsl/dune-project

@@ -27,5 +27,17 @@
  (name dsl)
  (synopsis "DSL for Programmable Packet Scheduling")
  (description "TBD")
- (depends ocaml dune ounit2 menhir))
+ (depends 
+   ocaml 
+   dune 
+   ounit2 
+   menhir 
+   ; libraries for Simulator
+   core_kernel 
+   pcap-format 
+   hex 
+   mmap
+   csv
+  )
+)
 

dsl/lib/ast.ml → dsl/frontend/ast.ml

@@ -7,7 +7,7 @@ type policy =
   | Fifo of policy list
   | RoundRobin of policy list
   | Strict of policy list
-  | WeightedFair of (policy * int) list
+  | WeightedFair of (policy * float) list
   | EarliestDeadline of policy list
   | ShortestJobNext of policy list
   | ShortestRemaining of policy list

dsl/lib/dune → dsl/frontend/dune

@@ -1,5 +1,6 @@
 (library
- (name dsl_core))
+ (name Frontend)
+ (public_name dsl.frontend))
 
 (menhir
  (modules parser))

dsl/frontend/frontend.ml

@@ -0,0 +1,3 @@
+module Ast = Ast
+module Parser = Parse
+module Policy = Policy

dsl/lib/lexer.mll → dsl/frontend/lexer.mll

@@ -3,16 +3,15 @@
 }
 
 let whitespace = [' ' '\t']+
-let digit = ['0'-'9']
-let int = '-'? digit+
+let int = '-'? ['0'-'9']+
+let float = '-'? (['0'-'9']* '.')? ['0'-'9']+
 let id = ['a'-'z'] ['a'-'z' '0'-'9' '_']*
 let bigid = ['A'-'Z']*
-let newline = ['\n']*
 let comment = ['/' '/'] ['\x00' - '\x09']* ['\x0b' - '\x80']*
 
 rule token = parse
 | whitespace            { token lexbuf}
-| newline               { Lexing.new_line lexbuf; token lexbuf }
+| "\n"                  { Lexing.new_line lexbuf; token lexbuf }
 | comment               { token lexbuf }
 | "="                   { EQUALS }
 | "["                   { LBRACKET }
@@ -41,6 +40,7 @@ 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 }
 
 

dsl/lib/parse.ml → dsl/frontend/parse.ml

@@ -1,23 +1,22 @@
 exception ParserError of string
 
-(* syntax_error_msg lexbuf is a syntax error message for the current position *)
+(* `syntax_error_msg lexbuf` is a syntax error message for the current
+   position *)
 let syntax_error_msg lexbuf =
   let pos = Lexing.lexeme_start_p lexbuf in
   let lnum, cnum = (pos.pos_lnum, pos.pos_cnum - pos.pos_bol) in
   Printf.sprintf "Syntax error at line %d, character %d" lnum cnum
 
 let parse lexbuf = Parser.prog Lexer.token lexbuf
 
-(* parse s parses a program string into an AST *)
+(* `parse s` parses a program string `s` into an AST *)
 let parse_string (s : string) =
   let lexbuf = Lexing.from_string s in
   try parse lexbuf
   with Parser.Error -> raise (ParserError (syntax_error_msg lexbuf))
 
-(* parse s parses a program file into an AST *)
+(* `parse s` parses a program file `s` into an AST *)
 let parse_file (f : string) =
   let lexbuf = Lexing.from_channel (open_in f) in
   try parse lexbuf
-  with Parser.Error ->
-    prerr_endline (syntax_error_msg lexbuf);
-    exit 1
+  with Parser.Error -> raise (ParserError (syntax_error_msg lexbuf))

dsl/lib/parser.mly → dsl/frontend/parser.mly

@@ -34,6 +34,7 @@
 
 %token <string> VAR
 %token <string> CLSS
+%token <float> FLOAT
 %token <int> INT
 %token EQUALS
 %token LBRACKET
@@ -98,7 +99,7 @@ arglist:
 weighted_arglist:
     | pl = separated_list(COMMA, weighted_arg)      { pl }
 weighted_arg:
-    | LPAREN; arg = separated_pair(policy, COMMA, INT); RPAREN      { arg }
+    | LPAREN; arg = separated_pair(policy, COMMA, FLOAT); RPAREN      { arg }
 
 /* Declarations, assignments and returns */
 internalcomp :

dsl/frontend/policy.ml

@@ -0,0 +1,58 @@
+(* Changes to this type must also be reflected in `Ast.policy` in ast.ml *)
+type t =
+  | Class of Ast.clss
+  | Fifo of t list
+  | RoundRobin of t list
+  | Strict of t list
+  | WeightedFair of (t * float) list
+
+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) 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 : 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) : t = sub cl alst ret (ref [])
+
+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 ", ")
+  in
+
+  match p with
+  | 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 -> sprintf "wfq%s" (join_weighted lst)

dsl/lib/policy.mli → dsl/frontend/policy.mli

@@ -4,18 +4,11 @@ type t =
   | Fifo of t list
   | RoundRobin of t list
   | Strict of t list
-  | WeightedFair of (t * int) list
-  | EarliestDeadline of t list
-  | ShortestJobNext of t list
-  | ShortestRemaining of t list
-  | RateControlled of t list
-  | LeakyBucket of t list * int * int
-  | TokenBucket of t list * int * int
-  | StopAndGo of t list * int
+  | WeightedFair of (t * float) list
 
 exception UnboundVariable of Ast.var
 exception UndeclaredClass of Ast.clss
 exception DuplicateClass of Ast.clss
 
-val from_program : Ast.program -> t
+val of_program : Ast.program -> t
 val to_string : t -> string