[Omake] [Patch] Replacing "+ <exp>" and "+ <value>" with something
more informative?
Aleksey Nogin
nogin at cs.caltech.edu
Thu Jun 8 16:54:00 PDT 2006
It seems to me that the "+ <exp>" and "+ <value>" messages are way too
uninformative. I wrote a patch (against 0.9.8.x) that makes them more
verbose (attached).
What do you think?
--
Aleksey Nogin
Home Page: http://nogin.org/
E-Mail: nogin at cs.caltech.edu (office), aleksey at nogin.org (personal)
Office: Moore 04, tel: (626) 395-2200
-------------- next part --------------
Index: src/ir/omake_ir_print.mli
===================================================================
--- src/ir/omake_ir_print.mli (revision 9275)
+++ src/ir/omake_ir_print.mli (working copy)
@@ -20,8 +20,8 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*
- * Author: Jason Hickey
- * @email{jyh at cs.caltech.edu}
+ * Author: Jason Hickey @email{jyh at cs.caltech.edu}
+ * Modified By: Aleksey Nogin @email{nogin at cs.caltech.edu}
* @end[license]
*)
open Lm_printf
@@ -33,14 +33,12 @@
val pp_print_string_exp : formatter -> string_exp -> unit
val pp_print_string_exp_list : formatter -> string_exp list -> unit
val pp_print_exp : formatter -> exp -> unit
+val pp_print_exp_simple : formatter -> exp -> unit
val pp_print_prog : formatter -> prog -> unit
-(*!
- * @docoff
- *
+(*
* -*-
* Local Variables:
- * Caml-master: "compile"
* End:
* -*-
*)
Index: src/ir/omake_command_type.ml
===================================================================
--- src/ir/omake_command_type.ml (revision 9275)
+++ src/ir/omake_command_type.ml (working copy)
@@ -4,7 +4,7 @@
* ----------------------------------------------------------------
*
* @begin[license]
- * Copyright (C) 2003 Mojave Group, Caltech
+ * Copyright (C) 2005-2006 Mojave Group, Caltech
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
@@ -20,14 +20,15 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*
- * Author: Jason Hickey
- * @email{jyh at cs.caltech.edu}
+ * Author: Jason Hickey @email{jyh at cs.caltech.edu}
+ * Modified By: Aleksey Nogin @email{nogin at cs.caltech.edu}
* @end[license]
*)
open Lm_printf
open Lm_location
open Omake_node
+open Omake_ir_print
(*
* Individual command arguments have three forms:
@@ -157,10 +158,10 @@
match inst with
CommandPipe argv ->
pp_print_argv buf argv
- | CommandEval _ ->
- pp_print_string buf "<exp>"
- | CommandValues _ ->
- pp_print_string buf "<values>"
+ | CommandEval exp ->
+ pp_print_exp_simple buf exp
+ | CommandValues values ->
+ fprintf buf "<compute %i value dependencies>" (List.length values)
let pp_print_command_line buf line =
pp_print_command_inst buf line.command_inst
@@ -169,12 +170,9 @@
List.iter (fun line -> fprintf buf "@ %a" pp_print_command_line line) lines
end;;
-(*!
- * @docoff
- *
+(*
* -*-
* Local Variables:
- * Caml-master: "compile"
* End:
* -*-
*)
Index: src/ir/omake_ir_print.ml
===================================================================
--- src/ir/omake_ir_print.ml (revision 9278)
+++ src/ir/omake_ir_print.ml (working copy)
@@ -20,8 +20,8 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*
- * Author: Jason Hickey
- * @email{jyh at cs.caltech.edu}
+ * Author: Jason Hickey @email{jyh at cs.caltech.edu}
+ * Modified By: Aleksey Nogin @email{nogin at cs.caltech.edu}
* @end[license]
*)
open Lm_printf
@@ -36,6 +36,12 @@
let print_location = Omake_ast_print.print_location
+let string_override s pp_fun complete buf arg =
+ if complete then
+ pp_fun true buf arg
+ else
+ pp_print_string buf s
+
(*
* Match kind.
*)
@@ -98,21 +104,20 @@
(*
* Scope.
*)
-let pp_print_scope_kind buf kind =
- match kind with
- ScopePrivate ->
- pp_print_string buf "private."
- | ScopeDynamic ->
- pp_print_string buf "public."
- | ScopeProtected ->
- pp_print_string buf "this."
- | ScopeGlobal ->
- pp_print_string buf "global."
+let pp_print_scope_kind complete buf kind =
+ if complete then
+ pp_print_string buf begin
+ match kind with
+ ScopePrivate -> "private."
+ | ScopeDynamic -> "public."
+ | ScopeProtected -> "this."
+ | ScopeGlobal -> "global."
+ end
(*
* Print a string expression.
*)
-let rec pp_print_string_exp buf s =
+let rec pp_print_string_exp complete buf s =
match s with
NoneString _ ->
fprintf buf "<none>"
@@ -123,65 +128,74 @@
| ApplyString (_, strategy, scope, v, []) ->
fprintf buf "@[<hv 3>$%a(%a%a)@]" (**)
pp_print_strategy strategy
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol v
| ApplyString (_, strategy, scope, v, args) ->
fprintf buf "@[<hv 3>$%a(%a%a %a)@]" (**)
pp_print_strategy strategy
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol v
- pp_print_string_exp_list args
+ (pp_print_string_exp_list complete) args
| SuperApplyString (_, strategy, scope, super, v, []) ->
fprintf buf "@[<hv 3>$%a(%a%a::%a)@]" (**)
pp_print_strategy strategy
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol super
pp_print_symbol v
| SuperApplyString (_, strategy, scope, super, v, args) ->
fprintf buf "@[<hv 3>$%a(%a%a::%a %a)@]" (**)
pp_print_strategy strategy
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol super
pp_print_symbol v
- pp_print_string_exp_list args
+ (pp_print_string_exp_list complete) args
| MethodApplyString (_, strategy, scope, vl, []) ->
fprintf buf "@[<hv 3>$%a(%a%a)@]" (**)
pp_print_strategy strategy
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_method_name vl
| MethodApplyString (_, strategy, scope, vl, args) ->
fprintf buf "@[<hv 3>$%a(%a%a %a)@]" (**)
pp_print_strategy strategy
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_method_name vl
- pp_print_string_exp_list args
+ (pp_print_string_exp_list complete) args
| SequenceString (_, sl) ->
fprintf buf "@[<hv 1>(%a)@]" (**)
- pp_print_string_exp_list sl
+ (pp_print_string_exp_list complete) sl
| ArrayOfString (_, s) ->
fprintf buf "@[<hv 1>(array-of-string@ %a)@]" (**)
- pp_print_string_exp s
+ (pp_print_string_exp complete) s
| ArrayString (_, sl) ->
fprintf buf "@[<hv 1>[|%a|]@]" (**)
- pp_print_string_exp_list sl
+ (pp_print_string_exp_list complete) sl
| QuoteString (_, sl) ->
fprintf buf "@[<hv 1>(quote %a)@]" (**)
- pp_print_string_exp_list sl
+ (pp_print_string_exp_list complete) sl
| QuoteStringString (_, c, sl) ->
fprintf buf "@[<hv 1>(quote %c%a%c)@]" (**)
- c pp_print_string_exp_list sl c
+ c (pp_print_string_exp_list complete) sl c
| BodyString (_, e) ->
- fprintf buf "@[<hv 3>body@ %a@]" pp_print_exp e
+ if complete then
+ fprintf buf "@[<hv 3>body@ %a@]" (pp_print_exp complete) e
+ else
+ pp_print_string buf "<body...>"
| ExpString (_, e) ->
- fprintf buf "@[<hv 3>exp@ %a@]" pp_print_exp e
+ if complete then
+ fprintf buf "@[<hv 3>exp@ %a@]" (pp_print_exp complete) e
+ else
+ pp_print_string buf "<exp...>"
| CasesString (_, cases) ->
- fprintf buf "@[<hv 3>cases:";
- List.iter (fun (v, e1, e2) ->
- fprintf buf "@ @[<hv 3>%a %a:@ %a@]" (**)
- pp_print_symbol v
- pp_print_string_exp e1
- pp_print_exp e2) cases;
- fprintf buf "@]"
+ if complete then begin
+ fprintf buf "@[<hv 3>cases:";
+ List.iter (fun (v, e1, e2) ->
+ fprintf buf "@ @[<hv 3>%a %a:@ %a@]" (**)
+ pp_print_symbol v
+ (pp_print_string_exp complete) e1
+ (pp_print_exp complete) e2) cases;
+ fprintf buf "@]"
+ end else
+ pp_print_string buf "<cases...>"
| ThisString (loc, ScopeProtected) ->
pp_print_string buf "$<this>"
| ThisString (loc, ScopePrivate) ->
@@ -191,89 +205,92 @@
| ThisString (loc, ScopeGlobal) ->
pp_print_string buf "$<global>"
-and pp_print_string_exp_list buf sl =
+and pp_print_string_exp_list complete buf sl =
match sl with
[s] ->
- pp_print_string_exp buf s
+ pp_print_string_exp complete buf s
| [] ->
()
| s :: sl ->
- fprintf buf "%a,@ %a" pp_print_string_exp s pp_print_string_exp_list sl
+ fprintf buf "%a,@ %a" (pp_print_string_exp complete) s (pp_print_string_exp_list complete) sl
(*
* Print an expression.
*)
-and pp_print_exp buf e =
- if !print_location then
+and pp_print_exp complete buf e =
+ if complete && !print_location then
fprintf buf "<%a>" pp_print_location (loc_of_exp e);
match e with
LetVarExp (_, scope, v, kind, s) ->
fprintf buf "@[<hv 3>%a%a %a@ %a@]" (**)
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol v
pp_print_var_def_kind kind
- pp_print_string_exp s
+ (pp_print_string_exp complete) s
| LetFunExp (_, scope, v, params, e) ->
fprintf buf "@[<hv 3>%a%a(%a) =@ %a@]" (**)
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol v
pp_print_symbol_list params
- pp_print_exp e
+ (string_override "<...>" pp_print_exp complete) e
| LetObjectExp (_, scope, v, el) ->
fprintf buf "@[<v 3>%a%a. =@ %a@]" (**)
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol v
- pp_print_exp_list el
+ (string_override "<...>" pp_print_exp_list complete) el
| LetThisExp (_, e) ->
- fprintf buf "@[<hv 3><this> =@ %a@]" pp_print_string_exp e
+ fprintf buf "@[<hv 3><this> =@ %a@]" (pp_print_string_exp complete) e
| ShellExp (_, e) ->
- fprintf buf "@[<hv 3>shell(%a)@]" pp_print_string_exp e
+ fprintf buf "@[<hv 3>shell(%a)@]" (pp_print_string_exp complete) e
| IfExp (_, cases) ->
- fprintf buf "@[<hv 0>if";
- List.iter (fun (s, e) ->
- fprintf buf "@ @[<hv 3>| %a ->@ %a@]" (**)
- pp_print_string_exp s
- pp_print_exp e) cases;
- fprintf buf "@]"
+ if complete then begin
+ fprintf buf "@[<hv 0>if";
+ List.iter (fun (s, e) ->
+ fprintf buf "@ @[<hv 3>| %a ->@ %a@]" (**)
+ (pp_print_string_exp complete) s
+ (pp_print_exp complete) e) cases;
+ fprintf buf "@]"
+ end else
+ pp_print_string buf "<if ... then ... [else ...]>"
| SequenceExp (_, el) ->
fprintf buf "@[<hv 3>sequence@ %a@]" (**)
- pp_print_exp_list el
+ (pp_print_exp_list complete) el
| SectionExp (_, s, el) ->
fprintf buf "@[<hv 3>section %a@ %a@]" (**)
- pp_print_string_exp s
- pp_print_exp_list el
+ (pp_print_string_exp complete) s
+ (string_override "<...>" pp_print_exp_list complete) el
| OpenExp (_, nodes) ->
fprintf buf "@[<hv 3>open";
List.iter (fun node -> fprintf buf "@ %a" pp_print_node node) nodes;
fprintf buf "@]"
| IncludeExp (_, s, commands) ->
fprintf buf "@[<hv 3>include %a:%a@]" (**)
- pp_print_string_exp s
- pp_print_commands commands
+ (pp_print_string_exp complete) s
+ (pp_print_commands complete) commands
| ApplyExp (_, scope, v, args) ->
fprintf buf "@[<hv 3>%a%a(%a)@]" (**)
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol v
- pp_print_string_exp_list args
+ (pp_print_string_exp_list complete) args
| SuperApplyExp (_, scope, super, v, args) ->
fprintf buf "@[<hv 0>%a%a::%a(%a)@]" (**)
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_symbol super
pp_print_symbol v
- pp_print_string_exp_list args
+ (pp_print_string_exp_list complete) args
| MethodApplyExp (_, scope, vl, args) ->
fprintf buf "@[<hv 3>%a%a(%a)@]" (**)
- pp_print_scope_kind scope
+ (pp_print_scope_kind complete) scope
pp_print_method_name vl
- pp_print_string_exp_list args
+ (pp_print_string_exp_list complete) args
| ReturnCatchExp (_, e) ->
- fprintf buf "@[<hv 3>return-catch@ %a@]" pp_print_exp e
+ fprintf buf "@[<hv 3>return-catch@ %a@]" (pp_print_exp complete) e
| StringExp (_, s) ->
- fprintf buf "string(%a)" pp_print_string_exp s
+ fprintf buf "string(%a)" (pp_print_string_exp complete) s
| ReturnExp (_, s) ->
- fprintf buf "return(%a)" pp_print_string_exp s
+ fprintf buf "return(%a)" (pp_print_string_exp complete) s
| ExportExp (_, s) ->
- fprintf buf "export(%a)" pp_print_string_exp s
+ fprintf buf "export(%a)" (pp_print_string_exp complete) s
| CancelExportExp _ ->
pp_print_string buf "cancel-export"
| ReturnSaveExp _ ->
@@ -288,31 +305,44 @@
fprintf buf "@[<hv 3>$|%s| %a@ %a@]" (**)
v
pp_print_var_def_kind kind
- pp_print_string_exp s
+ (pp_print_string_exp complete) s
| StaticExp (_, node, key, el) ->
fprintf buf "@[<hv 3>static(%a.%a):@ %a@]" (**)
pp_print_node node
pp_print_symbol key
- pp_print_exp_list el
+ (string_override "<...>" pp_print_exp_list complete) el
-and pp_print_exp_list buf el =
+and pp_print_exp_list complete buf el =
match el with
[e] ->
- pp_print_exp buf e
+ pp_print_exp complete buf e
| e :: el ->
- pp_print_exp buf e;
+ pp_print_exp complete buf e;
pp_print_space buf ();
- pp_print_exp_list buf el
+ pp_print_exp_list complete buf el
| [] ->
()
-and pp_print_prog buf el =
- fprintf buf "@[<v 0>%a@]" pp_print_exp_list el
+and pp_print_commands complete buf el =
+ List.iter (fun e -> fprintf buf "@ %a" (pp_print_string_exp complete) e) el
-and pp_print_commands buf el =
- List.iter (fun e -> fprintf buf "@ %a" pp_print_string_exp e) el
+(*
+ * Print simple parts, abbreviating others as "<exp>"
+ *)
+let pp_print_exp_simple = pp_print_exp false
(*
+ * The complete printers.
+ *)
+let pp_print_exp = pp_print_exp true
+let pp_print_scope_kind = pp_print_scope_kind true
+let pp_print_string_exp = pp_print_string_exp true
+let pp_print_string_exp_list = pp_print_string_exp_list true
+
+let pp_print_prog buf el =
+ fprintf buf "@[<v 0>%a@]" (pp_print_exp_list true) el
+
+(*
* -*-
* Local Variables:
* End:
More information about the OMake-Devel
mailing list