Tidy up the generated parsing code.
[virt-mem.git] / extract / codegen / kerneldb_to_parser.ml
index 1d56126..e1056c5 100644 (file)
@@ -418,12 +418,19 @@ Example (from toplevel of virt-mem source tree):
   let files =
     List.map (
       fun (name, _) ->
   let files =
     List.map (
       fun (name, _) ->
-       name,
-       List.filter_map (
-         fun (basename, version, arch, structures) ->
-           try Some (basename, version, arch, List.assoc name structures)
-           with Not_found -> None
-       ) datas
+       let kernels =
+         List.filter_map (
+           fun (basename, version, arch, structures) ->
+             try Some (basename, version, arch, List.assoc name structures)
+             with Not_found -> None
+         ) datas in
+
+       (* Sort the kernels, which makes the generated output more stable
+        * and makes patches more useful.
+        *)
+       let kernels = List.sort kernels in
+
+       name, kernels
     ) what in
 
   let datas = () in ignore datas; (* garbage collect *)
     ) what in
 
   let datas = () in ignore datas; (* garbage collect *)
@@ -496,7 +503,8 @@ Example (from toplevel of virt-mem source tree):
                  !i in
              (basename, version, arch, total_size, j)
          ) kernels in
                  !i in
              (basename, version, arch, total_size, j)
          ) kernels in
-       struct_name, kernels, field_types, List.rev !xs
+       let parsers = List.rev !xs in
+       struct_name, kernels, field_types, parsers
     ) files in
 
   (* How much did we save by sharing? *)
     ) files in
 
   (* How much did we save by sharing? *)
@@ -579,7 +587,7 @@ Example (from toplevel of virt-mem source tree):
                 *)
                let cmp (_, (_, o1, _)) (_, (_, o2, _)) = compare o1 o2 in
                let fields = List.sort ~cmp fields in
                 *)
                let cmp (_, (_, o1, _)) (_, (_, o2, _)) = compare o1 o2 in
                let fields = List.sort ~cmp fields in
-               String.concat ";\n    " (
+               String.concat ";\n      " (
                  List.map (
                    function
                    | (field_name, (`Int, offset, size))
                  List.map (
                    function
                    | (field_name, (`Int, offset, size))
@@ -593,7 +601,7 @@ Example (from toplevel of virt-mem source tree):
                  ) fields
                ) in
              let assignments =
                  ) fields
                ) in
              let assignments =
-               String.concat ";\n    " (
+               String.concat ";\n        " (
                  List.map (
                    function
                    | (field_name, (`Ptr "list_head", offset, size)) ->
                  List.map (
                    function
                    | (field_name, (`Ptr "list_head", offset, size)) ->
@@ -604,11 +612,13 @@ Example (from toplevel of virt-mem source tree):
                ) in
 
              let sub =
                ) in
 
              let sub =
-               sprintf "\
+               sprintf "
   bitmatch bits with
   bitmatch bits with
-  | { %s } -> { %s }
-  | { _ } -> raise (ParseError (%S, %S, \"failed to match kernel structure\"))"
-                 patterns assignments struct_name fnname in
+  | { %s } ->
+      { %s }
+  | { _ } ->
+      raise (ParseError (struct_name, %S, match_err))"
+                 patterns assignments fnname in
 
              fnname, sub
          ) parsers in
 
              fnname, sub
          ) parsers in
@@ -636,6 +646,8 @@ Example (from toplevel of virt-mem source tree):
        let code = <:str_item<
          let warning = "This code is automatically generated from the kernel database by kerneldb-to-parser program.  Any edits you make will be lost."
           let zero = 0
        let code = <:str_item<
          let warning = "This code is automatically generated from the kernel database by kerneldb-to-parser program.  Any edits you make will be lost."
           let zero = 0
+         let struct_name = $str:struct_name$
+         let match_err = "failed to match kernel structure"
           exception ParseError of string * string * string;;
          $struct_type$
          $parser_stmts$
           exception ParseError of string * string * string;;
          $struct_type$
          $parser_stmts$
@@ -661,6 +673,7 @@ Example (from toplevel of virt-mem source tree):
           exception ParseError of string * string * string;;
          $struct_sig$
 
           exception ParseError of string * string * string;;
          $struct_sig$
 
+          val struct_name : string
          type kernel_version = string
          val $lid:struct_name^"_known"$ : kernel_version -> bool
          val $lid:struct_name^"_size"$ : kernel_version -> int
          type kernel_version = string
          val $lid:struct_name^"_known"$ : kernel_version -> bool
          val $lid:struct_name^"_size"$ : kernel_version -> int