[asl][menhir2bnfc] Provide a way to sort the output bnfc/bnf

asllib/menhir2bnfc/BnfcAST.ml

@@ -93,6 +93,47 @@ let string_of_bnfc bnfc =
   let decl_strs = List.map print_decl_list grouped_decls in
   String.concat "\n\n" decl_strs
 
+(** Given a sorting order of the generated BNFC names. Order the bnfc ast
+    using the order of the names specified *)
+let sort_bnfc bnfc order =
+  let order_lookup = List.mapi (fun i e -> (e, i)) order in
+  let sort_fn el1 el2 =
+    let get_idx el =
+      match el with
+      | Decl (_, id, _) -> (
+          match
+            List.find_opt (fun (id2, _) -> String.equal id id2) order_lookup
+          with
+          | None -> Int.max_int
+          | Some (_, idx) -> idx + 1)
+      | Entrypoints _ -> 0
+    in
+    let l = get_idx el1 in
+    let r = get_idx el2 in
+    Int.compare l r
+  in
+  (* Sanity check that all order names actually exsit *)
+  let () =
+    let name_not_found =
+      List.filter
+        (fun n ->
+          not
+          @@ List.exists
+               (fun d ->
+                 match d with
+                 | Decl (_, id, _) -> String.equal id n
+                 | _ -> false)
+               bnfc)
+        order
+    in
+    if List.length name_not_found > 0 then (
+      Printf.printf
+        "The following names specified in the order list don't exist [%s]\n"
+      @@ String.concat ", " name_not_found;
+      raise @@ Failure "Order file error.")
+  in
+  List.sort sort_fn bnfc
+
 (** Convert the bnfc ast into a bnf string *)
 let bnf_of_bnfc bnfc =
   let convert_id name =

asllib/menhir2bnfc/menhir2bnfc.ml

@@ -20,14 +20,26 @@
 (* herdtools7 github repository.                                              *)
 (******************************************************************************)
 
-type args = { cmly_file : string; cf_file : string; output_bnf : bool }
+type args = {
+  cmly_file : string;
+  cf_file : string;
+  order_file : string option;
+  output_bnf : bool;
+}
 (** Command line arguments structure *)
 
 let parse_args () =
   let files = ref [] in
   let output_bnf = ref false in
+  let order_file = ref "" in
   let speclist =
-    [ ("--bnf", Arg.Set output_bnf, " Output in bnf format instead of bnfc.") ]
+    [
+      ("--bnf", Arg.Set output_bnf, " Output in bnf format instead of bnfc.");
+      ( "--order",
+        Arg.Set_string order_file,
+        " A file describing the desired order of bnfc names. Represented as a \
+         newline separated list of bnfc names." );
+    ]
   in
   let prog =
     if Array.length Sys.argv > 0 then Filename.basename Sys.argv.(0)
@@ -44,9 +56,10 @@ let parse_args () =
   in
   let () = Arg.parse speclist anon_fun usage_msg in
   let args =
+    let order_file = match !order_file with "" -> None | f -> Some f in
     match List.rev !files with
     | [ cmly; cf ] ->
-        { cmly_file = cmly; cf_file = cf; output_bnf = !output_bnf }
+        { cmly_file = cmly; cf_file = cf; output_bnf = !output_bnf; order_file }
     | _ ->
         let () = Printf.eprintf "%s invalid arguments!\n%s" prog usage_msg in
         exit 1
@@ -58,7 +71,9 @@ let parse_args () =
         let () = Printf.eprintf "%s cannot find file %S\n%!" prog s in
         exit 1
     in
-    ensure_exists args.cmly_file
+    ensure_exists args.cmly_file;
+    if Option.is_some args.order_file then
+      ensure_exists (Option.get args.order_file)
   in
   args
 
@@ -77,7 +92,18 @@ let with_open_out_bin file fn =
 let translate_to_str args =
   let open BnfcAST in
   let open CvtGrammar in
-  let bnfc = translate args.cmly_file in
+  let bnfc =
+    let initial = translate args.cmly_file in
+    match args.order_file with
+    | None -> initial
+    | Some ord_file ->
+        let parse_order chan =
+          let data = really_input_string chan (in_channel_length chan) in
+          String.trim data |> String.split_on_char '\n' |> List.map String.trim
+        in
+        let order = with_open_in_bin ord_file parse_order in
+        sort_bnfc initial order
+  in
   if args.output_bnf then bnf_of_bnfc bnfc else string_of_bnfc bnfc
 
 let () =

asllib/menhir2bnfc/order.txt

@@ -0,0 +1,71 @@
+Spec
+Decl
+RecurseLimit
+Subtype
+SubtypeOpt
+TypedIdentifier
+OptTypedIdentifier
+AsTy
+ReturnType
+ParamsOpt
+Call
+ElidedParamCall
+FuncArgs
+MaybeEmptyStmtList
+FuncBody
+IgnoredOrIdentifier
+LocalDeclKeywordNonVar
+GlobalDeclKeywordNonVar
+Direction
+CaseAltList
+CaseAlt
+CaseOtherwise
+OtherwiseOpt
+Catcher
+LoopLimit
+Stmt
+StmtList
+SElse
+Lexpr
+BasicLexpr
+NestedFields
+SlicedBasicLexpr
+DiscardOrSlicedBasicLexpr
+DiscardOrIdentifier
+DiscardOrField
+DeclItem
+ConstraintKindOpt
+ConstraintKind
+IntConstraint
+ExprPattern
+ExprPattern1
+ExprPattern2
+ExprPattern3
+ExprPattern4
+ExprPattern5
+ExprPattern6
+ExprPattern7
+ExprPattern8
+PatternSet
+PatternList
+Pattern
+Fields
+FieldsOpt
+Slices
+Slice
+Bitfields
+Bitfield
+Ty
+TyDecl
+FieldAssign
+EElse
+Expr
+Expr1
+Expr2
+Expr3
+Expr4
+Expr5
+Expr6
+Expr7
+Expr8
+Value