From 5c09abeb189b42026697f7735e0d86641d477eb2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Le=CC=81onard=20Ge=CC=81rard?= Date: Wed, 1 Sep 2010 13:31:28 +0200 Subject: [PATCH] Revet last commit a5f89876c2d3dcfb76ecc8ef74e306c1764cff7f and gives the right fix. Plus remove all the forbidden '\n', replaced with '@.' or '@\n' depending on context. --- compiler/global/location.ml | 2 +- compiler/global/modules.ml | 4 +- compiler/heptagon/analysis/causal.ml | 2 +- compiler/heptagon/analysis/initialization.ml | 2 +- compiler/heptagon/analysis/interface.ml | 2 +- compiler/heptagon/analysis/typing.ml | 49 ++++++++++---------- compiler/heptagon/parsing/hept_scoping.ml | 10 ++-- compiler/minils/analysis/clocking.ml | 4 +- compiler/minils/analysis/init.ml | 4 +- compiler/minils/main/mls2seq.ml | 4 +- compiler/minils/mls_utils.ml | 2 +- compiler/minils/transformations/callgraph.ml | 10 ++-- compiler/obc/c/c.ml | 3 +- compiler/obc/c/cgen.ml | 10 ++-- compiler/obc/c/cmain.ml | 4 +- compiler/obc/obc.ml | 2 +- compiler/obc/obc_printer.ml | 2 +- compiler/utilities/global/compiler_utils.ml | 8 ++-- compiler/utilities/misc.ml | 4 +- 19 files changed, 63 insertions(+), 65 deletions(-) diff --git a/compiler/global/location.ml b/compiler/global/location.ml index 76950db..fe1ab18 100644 --- a/compiler/global/location.ml +++ b/compiler/global/location.ml @@ -126,5 +126,5 @@ let print_location ff (Loc(p1,p2)) = copy_chunk lp2 np2 ic ff; (* copy interesting begining of l2 *) ) with Sys_error _ -> (); - Format.fprintf ff "@." end; + fprintf ff "@." diff --git a/compiler/global/modules.ml b/compiler/global/modules.ml index 0f55782..cbdcc29 100644 --- a/compiler/global/modules.ml +++ b/compiler/global/modules.ml @@ -68,7 +68,7 @@ let load_module modname = let m:env = input_value ic in if m.format_version <> interface_format_version then ( Format.eprintf "The file %s was compiled with \ - an older version of the compiler.\n \ + an older version of the compiler.@\n \ Please recompile %s.ept first.@." filename name; raise Error ); @@ -77,7 +77,7 @@ let load_module modname = with | End_of_file | Failure _ -> close_in ic; - Format.eprintf "Corrupted compiled interface file %s.\n\ + Format.eprintf "Corrupted compiled interface file %s.@\n\ Please recompile %s.ept first.@." filename name; raise Error with diff --git a/compiler/heptagon/analysis/causal.ml b/compiler/heptagon/analysis/causal.ml index 583e51f..bb0f08d 100644 --- a/compiler/heptagon/analysis/causal.ml +++ b/compiler/heptagon/analysis/causal.ml @@ -86,7 +86,7 @@ let message loc kind = begin match kind with | Ecausality_cycle(ac) -> eprintf - "%aCausality error: the following constraint is not causal.\n%a@." + "%aCausality error: the following constraint is not causal.@\n%a@." print_location loc output_ac ac end; diff --git a/compiler/heptagon/analysis/initialization.ml b/compiler/heptagon/analysis/initialization.ml index ab17569..685446f 100644 --- a/compiler/heptagon/analysis/initialization.ml +++ b/compiler/heptagon/analysis/initialization.ml @@ -169,7 +169,7 @@ module Error = struct begin match kind with | Eclash(left_ty, right_ty) -> Format.eprintf "%aInitialization error: this expression has type \ - %a, \n\ + %a, @\n\ but is expected to have type %a@." print_location loc Printer.print_type left_ty diff --git a/compiler/heptagon/analysis/interface.ml b/compiler/heptagon/analysis/interface.ml index 25d810f..07cbf28 100644 --- a/compiler/heptagon/analysis/interface.ml +++ b/compiler/heptagon/analysis/interface.ml @@ -102,7 +102,7 @@ struct (match constr with | [] -> () | constr -> - fprintf ff "\n with: @["; + fprintf ff "@\n with: @["; print_list_r Static.print_size_constraint "" "," "" ff constr; fprintf ff "@]" ); diff --git a/compiler/heptagon/analysis/typing.ml b/compiler/heptagon/analysis/typing.ml index c8973df..31b9da9 100644 --- a/compiler/heptagon/analysis/typing.ml +++ b/compiler/heptagon/analysis/typing.ml @@ -55,110 +55,109 @@ let error kind = raise (TypingError(kind)) let message loc kind = begin match kind with | Emissing(s) -> - Format.eprintf "%a@\nNo equation is given for name %s.@." + Format.eprintf "%aNo equation is given for name %s.@." print_location loc s; | Emissingcase(s) -> - Format.eprintf "%a@\nCase %s not defined.@." + Format.eprintf "%aCase %s not defined.@." print_location loc s; | Eundefined(s) -> - Format.eprintf "%a@\nThe name %s is unbound.@." + Format.eprintf "%aThe name %s is unbound.@." print_location loc s; | Elast_undefined(s) -> - Format.eprintf "%a@\nThe name %s does not have a last value.@." + Format.eprintf "%aThe name %s does not have a last value.@." print_location loc s; | Eshould_be_last(s) -> - Format.eprintf "%a@\nOnly the last value of %s can be accessed.@." + Format.eprintf "%aOnly the last value of %s can be accessed.@." print_location loc s; | Etype_clash(actual_ty, expected_ty) -> - Format.eprintf "%a@\nType Clash: this expression has type %a, \n\ + Format.eprintf "%aType Clash: this expression has type %a, @\n\ but is expected to have type %a.@." print_location loc Types.print_type actual_ty Types.print_type expected_ty | Earity_clash(actual_arit, expected_arit) -> - Format.eprintf - "%a@\nType Clash: this expression expects %d arguments,\n\ + Format.eprintf "%aType Clash: this expression expects %d arguments,@\n\ but is expected to have %d.@." print_location loc expected_arit actual_arit | Estatic_arity_clash(actual_arit, expected_arit) -> Format.eprintf - "%a@\nType Clash: this node expects %d static parameters,\n\ - but was given %d.@." + "%aType Clash: this node expects %d static parameters,@\n\ + but was given %d.@." print_location loc expected_arit actual_arit | Ealready_defined(s) -> - Format.eprintf "%a@\nThe name %s is already defined.@." + Format.eprintf "%aThe name %s is already defined.@." print_location loc s | Enon_exaustive -> - Format.eprintf "%a@\nSome constructors are missing in this \ + Format.eprintf "%aSome constructors are missing in this \ pattern/matching.@." print_location loc | Epartial_switch(s) -> Format.eprintf - "%a@\nThe case %s is missing.@." + "%aThe case %s is missing.@." print_location loc s | Etoo_many_outputs -> Format.eprintf - "%a@\nA function may only returns a basic value.@." + "%aA function may only returns a basic value.@." print_location loc | Esome_fields_are_missing -> Format.eprintf - "%a@\nSome fields are missing.@." + "%aSome fields are missing.@." print_location loc | Esubscripted_value_not_an_array ty -> Format.eprintf - "%a@\nSubscript used on a non array type : %a.@." + "%aSubscript used on a non array type : %a.@." print_location loc Types.print_type ty | Earray_subscript_should_be_const -> Format.eprintf - "%a@\nSubscript has to be a static value.@." + "%aSubscript has to be a static value.@." print_location loc | Eundefined_const ln -> Format.eprintf - "%a@\nThe const name '%s' is unbound.@." + "%aThe const name '%s' is unbound.@." print_location loc (fullname ln) | Econstraint_solve_failed c -> Format.eprintf - "%a@\nThe following constraint cannot be satisified:\n %a.@." + "%aThe following constraint cannot be satisified:@\n%a.@." print_location loc print_size_constraint c | Etype_should_be_static ty -> Format.eprintf - "%a@\nThis type should be static : %a.@." + "%aThis type should be static : %a.@." print_location loc Types.print_type ty | Erecord_type_expected ty -> Format.eprintf - "%a@\nA record was expected (found %a).@." + "%aA record was expected (found %a).@." print_location loc Types.print_type ty | Eno_such_field (ty, f) -> Format.eprintf - "%a@\nThe record type '%a' does not have a '%s' field.@." + "%aThe record type '%a' does not have a '%s' field.@." print_location loc Types.print_type ty (shortname f) | Eempty_record -> Format.eprintf - "%a@\nThe record is empty.@." + "%aThe record is empty.@." print_location loc | Eempty_array -> Format.eprintf - "%a@\nThe array is empty.@." + "%aThe array is empty.@." print_location loc | Efoldi_bad_args ty -> Format.eprintf - "%a@\nThe function given to foldi should expect an integer \ + "%aThe function given to foldi should expect an integer \ as the last but one argument (found: %a).@." print_location loc Types.print_type ty diff --git a/compiler/heptagon/parsing/hept_scoping.ml b/compiler/heptagon/parsing/hept_scoping.ml index ba93c82..d1cfe36 100644 --- a/compiler/heptagon/parsing/hept_scoping.ml +++ b/compiler/heptagon/parsing/hept_scoping.ml @@ -22,23 +22,23 @@ struct let message loc kind = begin match kind with | Evar name -> - eprintf "%a@\nThe value identifier %s is unbound.@." + eprintf "%aThe value identifier %s is unbound.@." print_location loc name | Econst_var name -> - eprintf "%a@\nThe const identifier %s is unbound.@." + eprintf "%aThe const identifier %s is unbound.@." print_location loc name | Evariable_already_defined name -> - eprintf "%a@\nThe variable %s is already defined.@." + eprintf "%aThe variable %s is already defined.@." print_location loc name | Econst_variable_already_defined name -> - eprintf "%a@\nThe const variable %s is already defined.@." + eprintf "%aThe const variable %s is already defined.@." print_location loc name | Estatic_exp_expected -> - eprintf "%a@\nA static expression was expected.@." + eprintf "%aA static expression was expected.@." print_location loc end; raise Misc.Error diff --git a/compiler/minils/analysis/clocking.ml b/compiler/minils/analysis/clocking.ml index ba419e4..b58ebf5 100644 --- a/compiler/minils/analysis/clocking.ml +++ b/compiler/minils/analysis/clocking.ml @@ -23,7 +23,7 @@ type error_kind = | Etypeclash of ct * ct let error_message loc = function | Etypeclash (actual_ct, expected_ct) -> - Format.eprintf "%aClock Clash: this expression has clock %a, \n\ + Format.eprintf "%aClock Clash: this expression has clock %a,@\n\ but is expected to have clock %a.@." print_location loc print_clock actual_ct @@ -116,7 +116,7 @@ let typing_eqs h eq_list = (*TODO FIXME*) let ty_pat = typing_pat h pat in (try expect h ty_pat e with | Error -> (* DEBUG *) - Format.eprintf "Complete expression: %a\nClock pattern: %a@." + Format.eprintf "Complete expression: %a@\nClock pattern: %a@." Mls_printer.print_exp e Mls_printer.print_clock ty_pat; raise Error) diff --git a/compiler/minils/analysis/init.ml b/compiler/minils/analysis/init.ml index 7f70290..a22d637 100644 --- a/compiler/minils/analysis/init.ml +++ b/compiler/minils/analysis/init.ml @@ -188,8 +188,8 @@ struct | Eclash (left_ty, right_ty) -> Format.eprintf "%aInitialization error: this expression has type \ - %a, \n\ - but is expected to have type %a\n" + %a,@\n\ + but is expected to have type %a@." print_location loc Printer.output_typ left_ty Printer. output_typ right_ty); raise Misc.Error) diff --git a/compiler/minils/main/mls2seq.ml b/compiler/minils/main/mls2seq.ml index f8a1156..66f9d78 100644 --- a/compiler/minils/main/mls2seq.ml +++ b/compiler/minils/main/mls2seq.ml @@ -46,7 +46,7 @@ let generate_target p s = let print_unfolded p_list = if !Misc.verbose then begin - Format.eprintf "** Unfolding done **\n@."; + Format.eprintf "** Unfolding done **@."; List.iter (Mls_printer.print stderr) p_list; end in @@ -68,7 +68,7 @@ let generate_target p s = print_unfolded p_list; if !Misc.verbose then begin - Format.eprintf "** Translation to Obc done **\n@."; + Format.eprintf "** Translation to Obc done **@."; List.iter (Obc_printer.print_prog Format.err_formatter) o_list; end; List.iter convert_fun o_list diff --git a/compiler/minils/mls_utils.ml b/compiler/minils/mls_utils.ml index c400284..38dfd77 100644 --- a/compiler/minils/mls_utils.ml +++ b/compiler/minils/mls_utils.ml @@ -33,7 +33,7 @@ let rec bounds_list ty = (** @return the [var_dec] object corresponding to the name [n] in a list of [var_dec]. *) let rec vd_find n = function - | [] -> Format.printf "Not found var %s\n" (name n); raise Not_found + | [] -> Format.eprintf "Not found var %s@." (name n); raise Not_found | vd::l -> if vd.v_ident = n then vd else vd_find n l diff --git a/compiler/minils/transformations/callgraph.ml b/compiler/minils/transformations/callgraph.ml index 6d0c124..b7f0413 100644 --- a/compiler/minils/transformations/callgraph.ml +++ b/compiler/minils/transformations/callgraph.ml @@ -220,8 +220,8 @@ let load_object_file modname = let p:program = input_value ic in if p.p_format_version <> minils_format_version then ( Format.eprintf "The file %s was compiled with \ - an older version of the compiler.\n \ - Please recompile %s.ept first.\n" filename name; + an older version of the compiler.@\n\ + Please recompile %s.ept first.@." filename name; raise Error ); close_in ic; @@ -229,12 +229,12 @@ let load_object_file modname = with | End_of_file | Failure _ -> close_in ic; - Format.eprintf "Corrupted object file %s.\n\ - Please recompile %s.ept first.\n" filename name; + Format.eprintf "Corrupted object file %s.@\n\ + Please recompile %s.ept first.@." filename name; raise Error with | Modules.Cannot_find_file(filename) -> - Format.eprintf "Cannot find the object file '%s'.\n" + Format.eprintf "Cannot find the object file '%s'.@." filename; raise Error diff --git a/compiler/obc/c/c.ml b/compiler/obc/c/c.ml index 22b95ac..7808251 100644 --- a/compiler/obc/c/c.ml +++ b/compiler/obc/c/c.ml @@ -287,7 +287,6 @@ let pp_cfile_desc fmt filen cfile = Misc.print_header_info fmt "/*" "*/"; fprintf fmt "#ifndef %s_H@\n" headern_macro; fprintf fmt "#define %s_H@\n@\n" headern_macro; - (* fprintf fmt "#include \"types.h\"\n"; *) iter (fun d -> fprintf fmt "#include \"%s.h\"@\n" d) deps; iter (pp_cdecl fmt) cdecls; @@ -307,7 +306,7 @@ let pp_cfile_desc fmt filen cfile = (** [output_cfile dir cfile] pretty-prints the content of [cfile] to the corresponding file in the [dir] directory. *) let output_cfile dir (filen, cfile_desc) = - if !Misc.verbose then Format.printf "C-NG generating %s/%s\n" dir filen; + if !Misc.verbose then Format.printf "C-NG generating %s/%s@." dir filen; let buf = Buffer.create 20000 in let oc = open_out (Filename.concat dir filen) in let fmt = Format.formatter_of_buffer buf in diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index fc89c4d..e2e2350 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -32,20 +32,20 @@ struct let message loc kind = (match kind with | Evar name -> - eprintf "%aCode generation : The variable name '%s' is unbound.\n" + eprintf "%aCode generation : The variable name '%s' is unbound.@." print_location loc name | Enode name -> - eprintf "%aCode generation : The node name '%s' is unbound.\n" + eprintf "%aCode generation : The node name '%s' is unbound.@." print_location loc name | Eno_unnamed_output -> - eprintf "%aCode generation : Unnamed outputs are not supported.\n" + eprintf "%aCode generation : Unnamed outputs are not supported.@." print_location loc | Ederef_not_pointer -> - eprintf "%aCode generation : Trying to deference a non pointer type.\n" + eprintf "%aCode generation : Trying to deference a non pointer type.@." print_location loc | Estatic_exp_compute_failed -> eprintf "%aCode generation : Computation of the value of the static \ - expression failed.\n" + expression failed.@." print_location loc); raise Misc.Error end diff --git a/compiler/obc/c/cmain.ml b/compiler/obc/c/cmain.ml index 7c18896..db2a5eb 100644 --- a/compiler/obc/c/cmain.ml +++ b/compiler/obc/c/cmain.ml @@ -31,14 +31,14 @@ and max_step = Idents.fresh "step_max" let assert_node_res cd = let stepm = find_step_method cd in if List.length stepm.m_inputs > 0 then - (Format.eprintf "Cannot generate run-time check for node %s with inputs.\n" + (Format.eprintf "Cannot generate run-time check for node %s with inputs.@." cd.cd_name; exit 1); if (match stepm.m_outputs with | [{ v_type = Tid nbool; }] when nbool = Initial.pbool -> false | _ -> true) then (Format.eprintf - "Cannot generate run-time check for node %s with non-boolean output.\n" + "Cannot generate run-time check for node %s with non-boolean output.@." cd.cd_name; exit 1); let mem = diff --git a/compiler/obc/obc.ml b/compiler/obc/obc.ml index 7a97f98..2ff509a 100644 --- a/compiler/obc/obc.ml +++ b/compiler/obc/obc.ml @@ -142,7 +142,7 @@ let rec vd_mem n = function (** Returns the var_dec object corresponding to the name n in a list of var_dec. *) let rec vd_find n = function - | [] -> Format.printf "Not found var %s\n" (name n); raise Not_found + | [] -> Format.eprintf "Not found var %s@." (name n); raise Not_found | vd::l -> if vd.v_ident = n then vd else vd_find n l diff --git a/compiler/obc/obc_printer.ml b/compiler/obc/obc_printer.ml index eaec210..fc60e39 100644 --- a/compiler/obc/obc_printer.ml +++ b/compiler/obc/obc_printer.ml @@ -157,7 +157,7 @@ let print_type_def ff { t_name = name; t_desc = tdesc } = match tdesc with | Type_abs -> fprintf ff "@[type %s@\n@]" name | Type_alias ty -> - fprintf ff "@[type %s@ = %a\n@]" name print_type ty + fprintf ff "@[type %s@ = %a@\n@]" name print_type ty | Type_enum(tag_name_list) -> fprintf ff "@[type %s = " name; print_list_r print_name "" "|" "" ff tag_name_list; diff --git a/compiler/utilities/global/compiler_utils.ml b/compiler/utilities/global/compiler_utils.ml index 296bb91..d5251e8 100644 --- a/compiler/utilities/global/compiler_utils.ml +++ b/compiler/utilities/global/compiler_utils.ml @@ -11,18 +11,18 @@ open Location open Minils let lexical_error err loc = - Format.eprintf "%aIllegal character.\n@." print_location loc; + Format.eprintf "%aIllegal character.@." print_location loc; raise Error let syntax_error loc = - Format.eprintf "%aSyntax error.\n@." print_location loc; + Format.eprintf "%aSyntax error.@." print_location loc; raise Error let language_error lang = - Format.eprintf "Unknown language: '%s'.\n@." lang + Format.eprintf "Unknown language: '%s'.@." lang let comment s = - if !verbose then Format.printf "** %s done **\n@." s + if !verbose then Format.printf "** %s done **@." s let do_pass f d p pp enabled = diff --git a/compiler/utilities/misc.ml b/compiler/utilities/misc.ml index f1ede88..e635ee5 100644 --- a/compiler/utilities/misc.ml +++ b/compiler/utilities/misc.ml @@ -35,10 +35,10 @@ let locate_stdlib () = Sys.getenv "HEPTLIB" with Not_found -> standard_lib in - Format.printf "Standard library in %s\n" stdlib + Format.printf "Standard library in %s@." stdlib let show_version () = - Format.printf "The Heptagon compiler, version %s (%s)\n" + Format.printf "The Heptagon compiler, version %s (%s)@." version date; locate_stdlib ()