jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Fixed location to use formatter instead of out_channel.

Browse source
This commit is contained in:
Léonard Gérard 2010-08-24 17:23:50 +02:00
parent 64c44efad5
commit 9df4f625a2
24 changed files with 195 additions and 215 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
compiler/global/location.ml
View file

@ -3,6 +3,7 @@
open Lexing
open Parsing
open Format
(* two important global variables: [input_name] and [input_chan] *)
type location =
@ -25,44 +26,44 @@ let error_prompt = ">"
(** Prints [n] times char [c] on [oc]. *)
let prints_n_chars oc n c = for i = 1 to n do output_char oc c done
let prints_n_chars ff n c = for i = 1 to n do pp_print_char ff c done
(** Prints out to [oc] a line designed to be printed under [line] from file [ic]
underlining from char [first] to char [last] with char [ch].
[line] is the index of the first char of line. *)
let underline_line ic oc ch line first last =
let underline_line ic ff ch line first last =
let c = ref ' '
and f = ref first
and l = ref (last-first) in
( try
seek_in ic line;
output_string oc error_prompt;
pp_print_string ff error_prompt;
while c := input_char ic; !c != '\n' do
if !f > 0 then begin
f := !f - 1;
output_char oc (if !c == '\t' then !c else ' ')
pp_print_char ff (if !c == '\t' then !c else ' ')
end
else if !l > 0 then begin
l := !l - 1;
output_char oc (if !c == '\t' then !c else ch)
pp_print_char ff (if !c == '\t' then !c else ch)
end
else ()
done
with End_of_file ->
if !f = 0 && !l > 0 then prints_n_chars oc 5 ch )
if !f = 0 && !l > 0 then prints_n_chars ff 5 ch )
let copy_lines nl ic oc prompt =
let copy_lines nl ic ff prompt =
for i = 1 to nl do
output_string oc prompt;
(try output_string oc (input_line ic)
with End_of_file -> output_string oc "<EOF>");
output_char oc '\n'
pp_print_string ff prompt;
(try pp_print_string ff (input_line ic)
with End_of_file -> pp_print_string ff "<EOF>");
pp_print_char ff '\n'
done
let copy_chunk p1 p2 ic oc =
try for i = p1 to p2 - 1 do output_char oc (input_char ic) done
with End_of_file -> output_string oc "<EOF>"
let copy_chunk p1 p2 ic ff =
try for i = p1 to p2 - 1 do pp_print_char ff (input_char ic) done
with End_of_file -> pp_print_string ff "<EOF>"
@ -74,7 +75,7 @@ let skip_lines n ic =
let output_location oc (Loc(p1,p2)) =
let print_location ff (Loc(p1,p2)) =
let n1 = p1.pos_cnum - p1.pos_bol in (* character number *)
let n2 = p2.pos_cnum - p2.pos_bol in
let np1 = p1.pos_cnum in (* character position *)
@ -87,16 +88,16 @@ let output_location oc (Loc(p1,p2)) =
let f2 = p2.pos_fname in
if f1 != f2 then (* Strange case *)
Printf.fprintf oc
"File \"%s\" line %d, character %d, to file \"%s\" line %d, character %d\n"
fprintf ff
"File \"%s\" line %d, character %d, to file \"%s\" line %d, character %d@\n"
f1 l1 n1 f2 l2 n2
else begin
if l2 > l1 then
Printf.fprintf oc
"File \"%s\", line %d-%d, characters %d-%d:\n" f1 l1 l2 n1 n2
fprintf ff
"File \"%s\", line %d-%d, characters %d-%d:@\n" f1 l1 l2 n1 n2
else
Printf.fprintf oc "File \"%s\", line %d, characters %d-%d:\n" f1 l1 n1 n2;
fprintf ff "File \"%s\", line %d, characters %d-%d:@\n" f1 l1 n1 n2;
(* Output source code *)
try
let ic = open_in f1 in
@ -104,27 +105,26 @@ let output_location oc (Loc(p1,p2)) =
if l1 == l2 then (
(* Only one line : copy full line and underline *)
seek_in ic lp1;
copy_lines 1 ic oc ">";
underline_line ic oc '^' lp1 n1 n2 )
copy_lines 1 ic ff ">";
underline_line ic ff '^' lp1 n1 n2 )
else (
underline_line ic oc '.' lp1 0 n1; (* dots until n1 *)
underline_line ic ff '.' lp1 0 n1; (* dots until n1 *)
seek_in ic np1;
(* copy the end of the line l1 after the dots *)
copy_lines 1 ic oc "";
copy_lines 1 ic ff "";
if l2 - l1 <= 8 then
(* copy the 6 or less middle lines *)
copy_lines (l2-l1-1) ic oc ">"
copy_lines (l2-l1-1) ic ff ">"
else (
(* sum up the middle lines to 6 *)
copy_lines 3 ic oc ">";
output_string oc "..........\n";
copy_lines 3 ic ff ">";
pp_print_string ff "..........\n";
skip_lines (l2-l1-7) ic; (* skip middle lines *)
copy_lines 3 ic oc ">"
copy_lines 3 ic ff ">"
);
output_string oc ">";
copy_chunk lp2 np2 ic oc; (* copy interesting begining of l2 *)
pp_print_string ff ">";
copy_chunk lp2 np2 ic ff; (* copy interesting begining of l2 *)
)
with Sys_error _ -> ();
output_char oc '\n'
Format.fprintf ff "@."
end;

10
compiler/global/modules.ml
View file

@ -67,9 +67,9 @@ let load_module modname =
try
let m:env = input_value ic in
if m.format_version <> interface_format_version then (
Printf.eprintf "The file %s was compiled with \
Format.eprintf "The file %s was compiled with \
an older version of the compiler.\n \
Please recompile %s.ept first.\n" filename name;
Please recompile %s.ept first.@." filename name;
raise Error
);
close_in ic;
@ -77,12 +77,12 @@ let load_module modname =
with
| End_of_file | Failure _ ->
close_in ic;
Printf.eprintf "Corrupted compiled interface file %s.\n\
Please recompile %s.ept first.\n" filename name;
Format.eprintf "Corrupted compiled interface file %s.\n\
Please recompile %s.ept first.@." filename name;
raise Error
with
| Cannot_find_file(filename) ->
Printf.eprintf "Cannot find the compiled interface file %s.\n"
Format.eprintf "Cannot find the compiled interface file %s.@."
filename;
raise Error

6
compiler/global/static.ml
View file

@ -90,7 +90,7 @@ let int_of_static_exp env se =
| Sint i -> i
| _ ->
(Format.eprintf "Internal compiler error, \
[eval_int] received the static_exp %a.\n" Types.print_static_exp se;
[eval_int] received the static_exp %a.@." Types.print_static_exp se;
assert false)
(** [is_true env constr] returns whether the constraint is satisfied
@ -171,7 +171,3 @@ let print_size_constraint ff = function
fprintf ff "@[%a <= %a@]" print_static_exp e1 print_static_exp e2
| Cfalse -> fprintf ff "Cfalse"
let psize_constraint oc c =
let ff = formatter_of_out_channel oc
in (print_size_constraint ff c; fprintf ff "@?")

8
compiler/heptagon/analysis/causal.ml
View file

@ -83,13 +83,11 @@ exception Error of error
let error kind = raise (Error(kind))
let message loc kind =
let output_ac oc ac =
let ff = formatter_of_out_channel oc in output_ac ff ac in
begin match kind with
| Ecausality_cycle(ac) ->
Printf.eprintf
"%aCausality error: the following constraint is not causal.\n%a\n."
output_location loc
eprintf
"%aCausality error: the following constraint is not causal.\n%a@."
print_location loc
output_ac ac
end;
raise Misc.Error

27
compiler/heptagon/analysis/initialization.ml
View file

@ -142,23 +142,18 @@ module Printer = struct
open Format
open Pp_tools
let rec fprint_init ff i = match i.i_desc with
let rec print_init ff i = match i.i_desc with
| Izero -> fprintf ff "0"
| Ione -> fprintf ff "1"
| Ivar -> fprintf ff "0"
| Imax(i1, i2) -> fprintf ff "@[%a\\/%a@]" fprint_init i1 fprint_init i2
| Ilink(i) -> fprint_init ff i
| Imax(i1, i2) -> fprintf ff "@[%a\\/%a@]" print_init i1 print_init i2
| Ilink(i) -> print_init ff i
let rec fprint_typ ff = function
| Ileaf(i) -> fprint_init ff i
let rec print_type ff = function
| Ileaf(i) -> print_init ff i
| Iproduct(ty_list) ->
fprintf ff "@[%a@]" (print_list_r fprint_typ "("" *"")") ty_list
fprintf ff "@[%a@]" (print_list_r print_type "("" *"")") ty_list
let output_typ oc ty =
let ff = formatter_of_out_channel oc in
fprintf ff "@[";
fprint_typ ff ty;
fprintf ff "@?@]"
end
module Error = struct
@ -173,12 +168,12 @@ module Error = struct
let message loc kind =
begin match kind with
| Eclash(left_ty, right_ty) ->
Printf.eprintf "%aInitialization error: this expression has type \
Format.eprintf "%aInitialization error: this expression has type \
%a, \n\
but is expected to have type %a\n"
output_location loc
Printer.output_typ left_ty
Printer.output_typ right_ty
but is expected to have type %a@."
print_location loc
Printer.print_type left_ty
Printer.print_type right_ty
end;
raise Misc.Error
end

10
compiler/heptagon/analysis/statefull.ml
View file

@ -22,12 +22,12 @@ type error =
let message loc kind =
begin match kind with
| Eshould_be_a_node ->
Printf.eprintf "%aThis node is statefull \
but was declared stateless.\n"
output_location loc
Format.eprintf "%aThis node is statefull \
but was declared stateless.@."
print_location loc
| Eexp_should_be_stateless ->
Printf.eprintf "%aThis expression should be stateless.\n"
output_location loc
Format.eprintf "%aThis expression should be stateless.@."
print_location loc
end;
raise Error

142
compiler/heptagon/analysis/typing.ml
View file

@ -55,111 +55,111 @@ let error kind = raise (TypingError(kind))
let message loc kind =
begin match kind with
| Emissing(s) ->
Printf.eprintf "%aNo equation is given for name %s.\n"
output_location loc
Format.eprintf "%aNo equation is given for name %s.@."
print_location loc
s;
| Emissingcase(s) ->
Printf.eprintf "%aCase %s not defined.\n"
output_location loc
Format.eprintf "%aCase %s not defined.@."
print_location loc
s;
| Eundefined(s) ->
Printf.eprintf "%aThe name %s is unbound.\n"
output_location loc
Format.eprintf "%aThe name %s is unbound.@."
print_location loc
s;
| Elast_undefined(s) ->
Printf.eprintf "%aThe name %s does not have a last value.\n"
output_location loc
Format.eprintf "%aThe name %s does not have a last value.@."
print_location loc
s;
| Eshould_be_last(s) ->
Printf.eprintf "%aOnly the last value of %s can be accessed.\n"
output_location loc
Format.eprintf "%aOnly the last value of %s can be accessed.@."
print_location loc
s;
| Etype_clash(actual_ty, expected_ty) ->
Printf.eprintf "%aType Clash: this expression has type %a, \n\
but is expected to have type %a.\n"
output_location loc
Hept_printer.ptype actual_ty
Hept_printer.ptype expected_ty
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) ->
Printf.eprintf "%aType Clash: this expression expects %d arguments,\n\
but is expected to have %d.\n"
output_location loc
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) ->
Printf.eprintf "%aType Clash: this node expects %d static parameters,\n\
but was given %d.\n"
output_location loc
Format.eprintf "%aType Clash: this node expects %d static parameters,\n\
but was given %d.@."
print_location loc
expected_arit actual_arit
| Ealready_defined(s) ->
Printf.eprintf "%aThe name %s is already defined.\n"
output_location loc
Format.eprintf "%aThe name %s is already defined.@."
print_location loc
s
| Enon_exaustive ->
Printf.eprintf "%aSome constructors are missing in this \
pattern/matching.\n"
output_location loc
Format.eprintf "%aSome constructors are missing in this \
pattern/matching.@."
print_location loc
| Epartial_switch(s) ->
Printf.eprintf
"%aThe case %s is missing.\n"
output_location loc
Format.eprintf
"%aThe case %s is missing.@."
print_location loc
s
| Etoo_many_outputs ->
Printf.eprintf
"%aA function may only returns a basic value.\n"
output_location loc
Format.eprintf
"%aA function may only returns a basic value.@."
print_location loc
| Esome_fields_are_missing ->
Printf.eprintf
"%aSome fields are missing.\n"
output_location loc
Format.eprintf
"%aSome fields are missing.@."
print_location loc
| Esubscripted_value_not_an_array ty ->
Printf.eprintf
"%aSubscript used on a non array type : %a.\n"
output_location loc
Hept_printer.ptype ty
Format.eprintf
"%aSubscript used on a non array type : %a.@."
print_location loc
Types.print_type ty
| Earray_subscript_should_be_const ->
Printf.eprintf
"%aSubscript has to be a static value.\n"
output_location loc
Format.eprintf
"%aSubscript has to be a static value.@."
print_location loc
| Eundefined_const ln ->
Printf.eprintf
"%aThe const name '%s' is unbound.\n"
output_location loc
Format.eprintf
"%aThe const name '%s' is unbound.@."
print_location loc
(fullname ln)
| Econstraint_solve_failed c ->
Printf.eprintf
"%aThe following constraint cannot be satisified:\n %a.\n"
output_location loc
psize_constraint c
Format.eprintf
"%aThe following constraint cannot be satisified:\n %a.@."
print_location loc
print_size_constraint c
| Etype_should_be_static ty ->
Printf.eprintf
"%aThis type should be static : %a.\n"
output_location loc
Hept_printer.ptype ty
Format.eprintf
"%aThis type should be static : %a.@."
print_location loc
Types.print_type ty
| Erecord_type_expected ty ->
Printf.eprintf
"%aA record was expected (found %a).\n"
output_location loc
Hept_printer.ptype ty
Format.eprintf
"%aA record was expected (found %a).@."
print_location loc
Types.print_type ty
| Eno_such_field (ty, f) ->
Printf.eprintf
"%aThe record type '%a' does not have a '%s' field.\n"
output_location loc
Hept_printer.ptype ty
Format.eprintf
"%aThe record type '%a' does not have a '%s' field.@."
print_location loc
Types.print_type ty
(shortname f)
| Eempty_record ->
Printf.eprintf
"%aThe record is empty.\n"
output_location loc
Format.eprintf
"%aThe record is empty.@."
print_location loc
| Eempty_array ->
Printf.eprintf
"%aThe array is empty.\n"
output_location loc
Format.eprintf
"%aThe array is empty.@."
print_location loc
| Efoldi_bad_args ty ->
Printf.eprintf
Format.eprintf
"%aThe function given to foldi should expect an integer \
as the last but one argument (found: %a).\n"
output_location loc
Hept_printer.ptype ty
as the last but one argument (found: %a).@."
print_location loc
Types.print_type ty
end;
raise Error

12
compiler/heptagon/hept_printer.ml
View file

@ -264,13 +264,13 @@ and print_block ff { b_local = v_list; b_equs = eqs; b_defnames = defnames } =
let print_type_def ff { t_name = name; t_desc = tdesc } =
match tdesc with
| Type_abs -> fprintf ff "@[type %s@\n@]" name
| Type_abs -> fprintf ff "@[type %s@.@]" name
| Type_alias ty ->
fprintf ff "@[type %s@ = %a\n@]" name print_type ty
fprintf ff "@[type %s@ = %a@.@]" name print_type ty
| Type_enum(tag_name_list) ->
fprintf ff "@[type %s = " name;
print_list_r print_name "" "| " "" ff tag_name_list;
fprintf ff "@\n@]"
fprintf ff "@.@]"
| Type_struct(f_ty_list) ->
fprintf ff "@[type %s = " name;
print_list_r
@ -306,7 +306,7 @@ let print_contract ff {c_block = b;
fprintf ff "assume %a@;enforce %a@;with (@[<hov>"
print_exp e_a
print_exp e_g;
fprintf ff "@])@]@\n"
fprintf ff "@])@]@."
let print_node_params ff = function
| [] -> ()
@ -338,10 +338,6 @@ let print_open_module ff name =
print_name ff name;
fprintf ff "@.@]"
let ptype oc ty =
let ff = formatter_of_out_channel oc in
print_type ff ty; fprintf ff "@?"
let print oc { p_opened = po; p_types = pt; p_nodes = pn; p_consts = pc } =
let ff = formatter_of_out_channel oc in
List.iter (print_open_module ff) po;

21
compiler/heptagon/parsing/hept_scoping.ml
View file

@ -7,7 +7,6 @@ open Hept_parsetree
open Names
open Idents
open Format
open Printf
open Static
open Modules
@ -23,24 +22,24 @@ struct
let message loc kind =
begin match kind with
| Evar name ->
eprintf "%aThe value identifier %s is unbound.\n"
output_location loc
eprintf "%aThe value identifier %s is unbound.@."
print_location loc
name
| Econst_var name ->
eprintf "%aThe const identifier %s is unbound.\n"
output_location loc
eprintf "%aThe const identifier %s is unbound.@."
print_location loc
name
| Evariable_already_defined name ->
eprintf "%aThe variable %s is already defined.\n"
output_location loc
eprintf "%aThe variable %s is already defined.@."
print_location loc
name
| Econst_variable_already_defined name ->
eprintf "%aThe const variable %s is already defined.\n"
output_location loc
eprintf "%aThe const variable %s is already defined.@."
print_location loc
name
| Estatic_exp_expected ->
eprintf "%aA static expression was expected.\n"
output_location loc
eprintf "%aA static expression was expected.@."
print_location loc
end;
raise Misc.Error
end

4
compiler/heptagon/transformations/inline.ml
View file

@ -48,8 +48,8 @@ let mk_unique_node nd =
let exp funs (env, newvars, newequs) exp = match exp.e_desc with
| Eiterator (it, { a_op = Enode nn; }, _, _, _) when to_be_inlined nn ->
Printf.eprintf
"WARN: inlining iterators (\"%s %s\" here) is unsupported.\n"
Format.eprintf
"WARN: inlining iterators (\"%s %s\" here) is unsupported.@."
(Hept_printer.iterator_to_string it) (fullname nn);
(exp, (env, newvars, newequs))

13
compiler/main/hept2mls.ml
View file

@ -17,7 +17,6 @@ open Static
open Types
open Clocks
open Format
open Printf
open Minils
open Mls_utils
@ -32,11 +31,11 @@ struct
let message loc kind =
begin match kind with
| Ereset_not_var ->
eprintf "%aOnly variables can be used for resets.\n"
output_location loc
eprintf "%aOnly variables can be used for resets.@."
print_location loc
| Eunsupported_language_construct ->
eprintf "%aThis construct is not supported by MiniLS.\n"
output_location loc
eprintf "%aThis construct is not supported by MiniLS.@."
print_location loc
end;
raise Misc.Error
end
@ -65,7 +64,7 @@ struct
let con env x e =
let rec conrec env =
match env with
| Eempty -> Printf.eprintf "%s\n" (name x); assert false
| Eempty -> Format.eprintf "%s@." (name x); assert false
| Eon(env, tag, name) ->
let e, ck = conrec env in
let ck_tag_name = Con(ck, tag, name) in
@ -155,7 +154,7 @@ let switch x ci_eqs_list =
else
begin
List.iter
(fun (x,e) -> Printf.eprintf "|%s|, " (name x))
(fun (x,e) -> Format.eprintf "|%s|, " (name x))
firsts;
assert false
end;

2
compiler/main/mls2obc.ml
View file

@ -106,7 +106,7 @@ let rec translate map (si, j, s) e =
let idx_list = List.map (fun idx -> mk_exp (Econst idx)) idx in
Elhs (lhs_of_idx_list (lhs_of_exp e) idx_list)
| _ ->
Mls_printer.print_exp stdout e;
Format.eprintf "%a" Mls_printer.print_exp e;
assert false
in
mk_exp ~ty:e.Minils.e_ty desc

11
compiler/minils/analysis/clocking.ml
View file

@ -16,16 +16,16 @@ open Signature
open Types
open Clocks
open Location
open Printf
open Format
(** Error Kind *)
type error_kind = | Etypeclash of ct * ct
let error_message loc = function
| Etypeclash (actual_ct, expected_ct) ->
Printf.eprintf "%aClock Clash: this expression has clock %a, \n\
but is expected to have clock %a.\n"
output_location loc
Format.eprintf "%aClock Clash: this expression has clock %a, \n\
but is expected to have clock %a.@."
print_location loc
print_clock actual_ct
print_clock expected_ct;
raise Error
@ -88,6 +88,7 @@ and typing_op op args h e ck = match op, args with
| Econcat, [e1; e2] ->
let ct = skeleton ck e.e_ty
in (expect h (Ck ck) e1; expect h ct e2; ct)
| Elambda _, _ -> Format.eprintf "Elambda dans le cloking"; assert false;
and expect h expected_ty e =
@ -115,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 *)
Printf.eprintf "Complete expression: %a\nClock pattern: %a\n"
Format.eprintf "Complete expression: %a\nClock pattern: %a@."
Mls_printer.print_exp e
Mls_printer.print_clock ty_pat;
raise Error)

20
compiler/minils/analysis/init.ml
View file

@ -156,24 +156,20 @@ struct
List.iter (fprintf ff "%s@]@ @[%a" sep print) l;
fprintf ff "%s@]" pf)
let rec fprint_init ff i =
let rec print_init ff i =
match i.i_desc with
| Izero -> fprintf ff "0"
| Ione -> fprintf ff "1"
| Ivar -> fprintf ff "0"
| Imax (i1, i2) ->
fprintf ff "@[%a\\/%a@]" fprint_init i1 fprint_init i2
| Ilink i -> fprint_init ff i
fprintf ff "@[%a\\/%a@]" print_init i1 print_init i2
| Ilink i -> print_init ff i
let rec fprint_typ ff =
let rec print_type ff =
function
| Ileaf i -> fprint_init ff i
| Ileaf i -> print_init ff i
| Iproduct ty_list ->
fprintf ff "@[%a@]" (print_list_r fprint_typ "(" " *" ")") ty_list
let output_typ oc ty =
let ff = formatter_of_out_channel oc
in (fprintf ff "@["; fprint_typ ff ty; fprintf ff "@?@]")
fprintf ff "@[%a@]" (print_list_r fprint_type "(" " *" ")") ty_list
end
@ -190,11 +186,11 @@ struct
let message loc kind =
((match kind with
| Eclash (left_ty, right_ty) ->
Printf.eprintf
Format.eprintf
"%aInitialization error: this expression has type \
%a, \n\
but is expected to have type %a\n"
output_location loc Printer.output_typ left_ty Printer.
print_location loc Printer.output_typ left_ty Printer.
output_typ right_ty);
raise Misc.Error)

4
compiler/minils/main/mls2seq.ml
View file

@ -46,7 +46,7 @@ let generate_target p s =
let print_unfolded p_list =
if !Misc.verbose then
begin
Printf.fprintf stderr "** Unfolding done **\n\n";
Format.eprintf "** Unfolding done **\n@.";
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
Printf.fprintf stderr "** Translation to Obc done **\n\n";
Format.eprintf "** Translation to Obc done **\n@.";
List.iter (wrap_print Obc_printer.print_prog stderr) o_list;
end;
List.iter convert_fun o_list

2
compiler/minils/mls_utils.ml
View file

@ -15,7 +15,7 @@ type err_kind = | Enot_static_exp
let err_message ?(exp=void) ?(loc=exp.e_loc) = function
| Enot_static_exp ->
Printf.eprintf "The expression %a should be a static_exp.@."
Format.eprintf "The expression %a should be a static_exp.@."
print_exp exp;
raise Error

2
compiler/minils/transformations/callgraph.ml
View file

@ -4,7 +4,7 @@ open Names
open Idents
open Format
open Location
open Printf
open Format
open Static
open Signature

14
compiler/minils/transformations/callgraph_mapfold.ml
View file

@ -18,12 +18,12 @@ struct
let message loc kind =
begin match kind with
| Enode_unbound ln ->
Printf.eprintf "%aUnknown node '%s'\n"
output_location loc
Format.eprintf "%aUnknown node '%s'@."
print_location loc
(fullname ln)
| Evar_unbound n ->
Printf.eprintf "%aUnbound static var '%s'\n"
output_location loc
Format.eprintf "%aUnbound static var '%s'\n"
print_location loc
n
end;
raise Misc.Error
@ -219,7 +219,7 @@ let load_object_file modname =
try
let p:program = input_value ic in
if p.p_format_version <> minils_format_version then (
Printf.eprintf "The file %s was compiled with \
Format.eprintf "The file %s was compiled with \
an older version of the compiler.\n \
Please recompile %s.ept first.\n" filename name;
raise Error
@ -229,12 +229,12 @@ let load_object_file modname =
with
| End_of_file | Failure _ ->
close_in ic;
Printf.eprintf "Corrupted object file %s.\n\
Format.eprintf "Corrupted object file %s.\n\
Please recompile %s.ept first.\n" filename name;
raise Error
with
| Modules.Cannot_find_file(filename) ->
Printf.eprintf "Cannot find the object file '%s'.\n"
Format.eprintf "Cannot find the object file '%s'.\n"
filename;
raise Error

2
compiler/obc/c/c.ml
View file

@ -307,7 +307,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 Printf.printf "C-NG generating %s/%s\n" dir filen;
if !Misc.verbose then Format.printf "C-NG generating %s/%s\n" 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

12
compiler/obc/c/cgen.ml
View file

@ -19,7 +19,7 @@ open Modules
open Signature
open C
open Location
open Printf
open Format
module Error =
struct
@ -33,20 +33,20 @@ struct
let message loc kind = (match kind with
| Evar name ->
eprintf "%aCode generation : The variable name '%s' is unbound.\n"
output_location loc name
print_location loc name
| Enode name ->
eprintf "%aCode generation : The node name '%s' is unbound.\n"
output_location loc name
print_location loc name
| Eno_unnamed_output ->
eprintf "%aCode generation : Unnamed outputs are not supported.\n"
output_location loc
print_location loc
| Ederef_not_pointer ->
eprintf "%aCode generation : Trying to deference a non pointer type.\n"
output_location loc
print_location loc
| Estatic_exp_compute_failed ->
eprintf "%aCode generation : Computation of the value of the static \
expression failed.\n"
output_location loc);
print_location loc);
raise Misc.Error
end

10
compiler/obc/c/cmain.ml
View file

@ -19,7 +19,7 @@ open Signature
open C
open Cgen
open Location
open Printf
open Format
open Compiler_utils
(** {1 Main C function generation} *)
@ -31,13 +31,13 @@ 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
(Printf.eprintf "Cannot generate run-time check for node %s with inputs.\n"
(Format.eprintf "Cannot generate run-time check for node %s with inputs.\n"
cd.cd_name;
exit 1);
if (match stepm.m_outputs with
| [{ v_type = Tid nbool; }] when nbool = Initial.pbool -> false
| _ -> true) then
(Printf.eprintf
(Format.eprintf
"Cannot generate run-time check for node %s with non-boolean output.\n"
cd.cd_name;
exit 1);
@ -116,7 +116,7 @@ let main_def_of_class_def cd =
| _ -> assert false in
let (prompt, args_format_s) = mk_prompt lhs in
let scan_exp =
let printf_s = Printf.sprintf "%s ? " prompt in
let printf_s = Format.sprintf "%s ? " prompt in
let format_s = format_for_type ty in
Csblock { var_decls = [];
block_body = [
@ -256,7 +256,7 @@ let mk_main name p = match (!Misc.simulation_node, !Misc.assert_nodes) with
let find_class n =
try List.find (fun cd -> cd.cd_name = n) p.p_defs
with Not_found ->
Printf.eprintf "Unknown node %s.\n" n;
Format.eprintf "Unknown node %s.\n" n;
exit 1 in
let a_classes = List.map find_class n_names in

2
compiler/preproc.ml
View file

@ -24,7 +24,7 @@ let date =
let prefix s = String.sub s 0 3 in
(prefix days.(tm.tm_wday), prefix months.(tm.tm_mon)) in
Printf.sprintf "%s. %s. %d %d:%d:%d CET %d"
Format.sprintf "%s. %s. %d %d:%d:%d CET %d"
day month tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec (1900 + tm.tm_year)

8
compiler/utilities/global/compiler_utils.ml
View file

@ -11,18 +11,18 @@ open Location
open Minils
let lexical_error err loc =
Printf.eprintf "%aIllegal character.\n" output_location loc;
Format.eprintf "%aIllegal character.\n" print_location loc;
raise Error
let syntax_error loc =
Printf.eprintf "%aSyntax error.\n" output_location loc;
Format.eprintf "%aSyntax error.\n" print_location loc;
raise Error
let language_error lang =
Printf.eprintf "Unknown language: '%s'.\n" lang
Format.eprintf "Unknown language: '%s'.\n" lang
let comment s =
if !verbose then Printf.printf "** %s done **\n" s; flush stdout
if !verbose then Format.printf "** %s done **\n" s; flush stdout
let do_pass f d p pp enabled =

4
compiler/utilities/misc.ml
View file

@ -35,10 +35,10 @@ let locate_stdlib () =
Sys.getenv "HEPTLIB"
with
Not_found -> standard_lib in
Printf.printf "Standard library in %s\n" stdlib
Format.printf "Standard library in %s\n" stdlib
let show_version () =
Printf.printf "The Heptagon compiler, version %s (%s)\n"
Format.printf "The Heptagon compiler, version %s (%s)\n"
version date;
locate_stdlib ()