Commits

ccorrodi committed 661e880

add various debug output related changes

- ast.ml:
- add functions for debug output
- update rule handling
- move string functions (indentation) around
- ast.mli:
- expose rule fields
- new debug function
- main.ml:
- add command line flag to toggle debug output
- ocamlmake.ml:
- add debug function
- introduce skeleton for post-processing ast
- ocamlmake.mli:
- expose debug function
- parser.mly:
- note on linking rules (previous_rule field)

Comments (0)

Files changed (6)

 
 module L = List
 module S = Str
+module P = Pervasives
 
 (** {2 Types} *)
 (** The command type represents a command that make runs. *)
 let s_flavor_append = "+="
 let s_flavor_conditional = "?="
 
+(** {2 String Functions} *)
+(** Denote by how many tabs a line should be indented when using indent. *)
+let d_indent : int ref = ref 0
+
+(** Indent each line in s by i tabs. *)
+let indent_num (i : int) (s : string) : string =
+  S.global_replace (S.regexp "^.*$") (String.make i '\t' ^ "\\0") s
+
+(** Indent all lines by d_indent tabs. *)
+let indent (s : string) : string =
+  indent_num !d_indent s
+
+(** Indent by one tab. *)
+let indent_1 (s : string) : string =
+  indent_num 1 s
+
 (** {2 String / Type Conversion} *)
 (** Convert a string to a command. *)
 let s_to_command (s : string) : command =
   let commands = String.concat "\n" r.r_commands in
   Printf.sprintf "%s%s%s\n%s" targets colon deps commands
 
+(** Convert a dependency to a string. *)
+let dep_to_s (d : dependency) : string =
+  d
+
 (** {2 Initialization} *)
 (** Initialize a variable. *)
 let make_var (n : string) (v : string)
     r_in_use = in_use;
   }
 
+(** Return a new rule corresponding to `r' with the next field set to `n'. *)
+let set_next (r : rule) (n : rule) : rule =
+  make_rule
+    ~next:(Some n)
+    ~targets:r.r_targets
+    ~suffixes:r.r_suffixes
+    ~deps:r.r_deps
+    ~commands:r.r_commands
+    ~num:r.r_num
+    ~terminal:r.r_terminal
+    ~in_use:r.r_in_use
+
 (** Initialize a dependency.
 
     TODO: Either enhance the dependency type or remove most arguments in this
 let pp_files (d : database) : string =
   let file_strings = L.map s_of_rule d.d_files in
   String.concat "\n" file_strings
+
+(** {2 Debug} *)
+
+(** Return a string containing the variable section of the given database,
+    including all information from the variable type. *)
+let pp_ast_vars (d : database) : string =
+  let debug_var (v : variable) : string =
+    let name = v.v_name in
+    let value = v.v_value in
+    let origin =
+      match v.v_origin with
+      | ODefault ->
+          "default"
+      | OEnv ->
+          "env"
+      | OFile ->
+          "file"
+      | OEnvOverride ->
+          "envoverride"
+      | OCommand ->
+          "command"
+      | OOverride ->
+          "override"
+      | OAutomatic ->
+          "automatic"
+      | OInvalid ->
+          "invalid"
+    in
+    let flavor =
+      match v.v_flavor with
+      | FBogus ->
+          "bogus"
+      | FSimple ->
+          "simple"
+      | FRecursive ->
+          "recursive"
+      | FAppend ->
+          "append"
+      | FConditional ->
+          "conditional"
+    in
+    Printf.sprintf "name: %s\nvalue: %s\norigin: %s\nflavor: %s\n" name value
+                                                                origin flavor
+  in
+
+  String.concat "\n" (L.map debug_var d.d_variables)
+
+let pp_ast_rules (d : database) : string =
+  let debug_rule (r : rule) : string =
+    let next =
+      "Next: " ^
+      match r.r_next with
+      | Some rule ->
+          String.concat ", " rule.r_targets
+      | None ->
+          "None"
+    in
+    let targets =
+      "Targets: " ^ (String.concat ", " r.r_targets)
+    in
+    let suffixes =
+      "Suffixes: " ^ (String.concat ", " r.r_suffixes)
+    in
+    let deps =
+        "Dependencies:\n" ^
+                    (indent_1 (String.concat "\n" (L.map dep_to_s r.r_deps)))
+    in
+    let commands =
+      "Commands:\n" ^ (indent_1 (String.concat "\n" r.r_commands))
+    in
+    let num_targets = "Number of targets: " ^ P.string_of_int r.r_num in
+    let is_terminal = "Terminal: " ^ P.string_of_bool r.r_terminal in
+    let is_in_use = "Is in use: " ^ P.string_of_bool r.r_in_use in
+
+    String.concat "\n" [
+      "==========";
+      targets; next; suffixes; deps; commands;
+      num_targets; is_terminal; is_in_use;
+      "==========";
+    ]
+  in
+
+  String.concat "\n\n" (L.map debug_rule d.d_implicit_rules)
+
+(** Return a pretty printed version of the database. *)
+let pp_database (d : database) : string =
+  let var_header = indent "Variables:" in
+  incr d_indent;
+  let vars = indent (pp_ast_vars d) in
+  decr d_indent;
+
+  let rule_header = indent "Rules:" in
+  incr d_indent;
+  let rules = indent (pp_ast_rules d) in
+  decr d_indent;
+  String.concat "\n" [var_header; vars; rule_header; rules]
+
+
+(** Print the ast to stdout. The output shows the structure of the ast and can
+    not be used with GNU make (in contrast to the pp_... functions. *)
+let pp_ast (a : ast) : string =
+  d_indent := 1;
+  let dbs = String.concat "\n" (L.map pp_database a) in
+  "AST:\n" ^ dbs
 type dependency
 
 (** Represent a rule definition. *)
-type rule
+type rule = {
+  r_next : rule option;
+  r_targets : string list;
+  (** After `%' of each target. *)
+  r_suffixes : string list;
+  r_deps : dependency list;
+  r_commands : command list;
+  (** Number of targets. *)
+  r_num : int;
+  (** True, if it's a terminal (`::'). *)
+  r_terminal : bool;
+  (** True, if in use by a parent pattern_search (see rule.h). *)
+  r_in_use : bool; (* if in use ␁by a parent pattern_search *)
+}
 
 (** Represent a single database, containing all sections. A genrated file can
     contain multiple databases. *)
 val make_var :
   string -> string -> variable_origin -> variable_flavor -> variable
 
+(** Return a new rule corresponding to the first argument with the next field
+    set to the second argument. *)
+val set_next : rule -> rule -> rule
+
 (** Create a rule instance of given inputs. *)
 val make_rule :
   next : rule option ->
 (** Return a string of the files section. The returned string is in valid
     make data base format. *)
 val pp_files : database -> string
+
+(** {2 Debug} *)
+(** Print the ast to stdout. The output shows the structure of the ast and can
+    not be used with GNU make (in contrast to the pp_... functions. *)
+val pp_ast : ast -> string
 (** {2 Options} *)
 (** If set to true, print the parsed database to stdout. *)
 let o_print_database : bool ref = ref false
+
 (** When o_print_database is true, o_print_cmds denotes whether the command
     section is printed to stdout or not. In order to use a printed database
     with make (e.g. "make -f generated_file.mkdb sometarget"), the command
     section should be omitted. *)
 let o_print_cmds : bool ref = ref false
+
 (** Name of the file to parse. Note that only one file will be parsed at a
     time, if multiple files are supplied an error message is printed. *)
 let o_filename : string ref = ref ""
+
 (** Denotes if o_filename has been set to some value. Used to avoid passing
     multiple filenames. *)
 let o_filename_set : bool ref = ref false
 
-(** {2 Command-line argument handling} *)
-let print_database (s : string) : unit =
-  let ast = O.parse_file (open_in s) in
-  Printf.printf "%s" (O.ast_to_db_string ast ~print_cmds:!o_print_cmds ())
+(** If set to true, the ast will be printed to stdout. *)
+let o_print_ast : bool ref = ref false
 
-let usage_msg =
+(** {2 Command-line argument handling} *)
+let usage_msg : string =
   Printf.sprintf "Usage:\n %s [options] <filename>\n\nOptions:" Sys.argv.(0)
 
 (** Print usage information to stdout. *)
 let rec print_usage (error_msg : string) : unit =
-  Printf.printf "%s\n\n" error_msg;
+  if error_msg <> "" then
+    Printf.printf "%s\n\n" error_msg;
   Arg.usage (Arg.align speclist) usage_msg
 
 (** List of options for the command line. *)
       "the command section is not printed to stdout. Defaults to true.");
     "-p", Arg.Unit(fun _ -> o_print_database := true),
                 " Parse the given database and print it to stdout.";
+    "-a", Arg.Unit(fun _ -> o_print_ast := true),
+                " Print the ast of the parsed file to stdout.";
     "-h", Arg.Unit(usage), " doc for h";
     "-help", Arg.Unit(usage), " doc for help";
     "--help", Arg.Unit(usage), " doc for more help";
 (** {2 Main} *)
 (** Execute the desired actions. *)
 let process () : unit =
+  let ast = O.parse_file (open_in !o_filename) in
+
   if !o_print_database then
-    print_database !o_filename
+    Printf.printf "%s" (O.ast_to_db_string ast ~print_cmds:!o_print_cmds ());
+
+  if !o_print_ast then
+    O.debug_ast ast;
+
+  ()
+
 
 (** Process the makefile database given as argument. *)
 let _ =
           t
 
 (** {2 Input} *)
+(** Process the given raw ast after parsing. This includes pointing to actual
+    rules in dependencies, etc. *)
+let post_parse (a : A.ast) : A.ast =
+  a
+
 (** Parse the database from given input file input and return the generated
     ast.*)
 let parse_file (input : in_channel) : A.ast =
   let lexbuf = Lexing.from_channel input in
-  try
-    Parser.input (deflate Lexer.command_token) lexbuf
-  with exn ->
-    begin
-      let curr = lexbuf.Lexing.lex_curr_p in
-      let line = curr.Lexing.pos_lnum in
-      let cnum = curr.Lexing.pos_cnum - curr.Lexing.pos_bol in
-      let tok = Lexing.lexeme lexbuf in
-      Printf.printf "line: %d, cnum: %d, tok: \"%s\"\n" line cnum tok;
-      raise exn
-    end
+  let ast =
+    try
+      Parser.input (deflate Lexer.command_token) lexbuf
+    with exn ->
+      begin
+        let curr = lexbuf.Lexing.lex_curr_p in
+        let line = curr.Lexing.pos_lnum in
+        let cnum = curr.Lexing.pos_cnum - curr.Lexing.pos_bol in
+        let tok = Lexing.lexeme lexbuf in
+        Printf.printf "line: %d, cnum: %d, tok: \"%s\"\n" line cnum tok;
+        raise exn
+      end
+  in
+  post_parse ast
 
 (** {2 Output} *)
 (** Generate a valid make database string that corresponds to the given ast. *)
         (ast_to_db_string ds ~print_cmds:print_cmds ())
   | [] ->
       ""
+
+(** {2 Debug} *)
+let debug_ast (a : A.ast) : unit =
+  Printf.printf "%s" (A.pp_ast a)

src/ocamlmake.mli

 (** {2 Output} *)
 (** Generate a valid make database string that corresponds to the given ast. *)
 val ast_to_db_string : Ast.ast -> ?print_cmds:bool -> unit -> string
+
+(** {2 Debug} *)
+val debug_ast : Ast.ast -> unit
   module A = Ast
   module S = Str
   module L = List
+
+  let previous_rule : A.rule option ref = ref None
 %}
 
 %token VARSEP DIRSEP RULESEP FILESEP FINISHED
 
 in_rules:
   | rule in_rules {
+    begin
+      match !previous_rule with
+      | None -> ()
+      | Some previous_rule ->
+          (*
+            TODO: this may or may not work as intended. Maybe we need to link
+            the rules in ocamlmake.ml's post process method.
+          previous_rule.A.r_next := Some rule;
+          *)
+          ()
+    end;
     $1 :: $2
   }
   | COMMENT in_rules {