Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[cleanup] jlog: remove Base.jlog

  • Loading branch information...
commit da5de875fa6ada3f957dde7408bbaa48c7e9363b 1 parent bc2add4
Raja authored
View
6 libbase/base.mli
@@ -147,12 +147,6 @@ val sprintf : ('a, unit, string) format -> 'a
(**
deprecated jlog. is implemented with function [ignore]
*)
-val jlog :
- ?long:bool ->
- ?color:Ansi.color ->
- ?level:int ->
- string -> unit
-
val log_error :
?long:bool ->
?color:Ansi.color ->
View
2  libbase/indexer.ml
@@ -47,7 +47,7 @@ let common_words = Str.regexp "\\(a\\(bout\\|ll\\|n[dy]\\|re\\|[mnst]\\)\\|b\\(u
returns the updated map with occurences from s *)
let utf8_string map s =
let bad_utf8 () =
- Base.jlog ~level:3 "Invalid utf-8 in string, not indexing"; map in
+ (* Base.jlog ~level:3 "Invalid utf-8 in string, not indexing";*) map in
let add_word map w =
match StringMap.find_opt w map with
| Some num -> StringMap.add w (num + 1) map
View
12 libbase/io.ml
@@ -31,7 +31,7 @@ struct
let zs = Zlib.deflate_init level header in
let (_, _(*used_in*), used_out) = Zlib.deflate zs inbuf 0 length outbuf 0 length Zlib.Z_NO_FLUSH in
let rec aux finished used_out =
- Base.jlog (Printf.sprintf "aux_compr: used_out = %d" used_out) ;
+ Printf.eprintf "aux_compr: used_out = %d\n" used_out;
if finished then used_out
else
let (finished, _, add) = Zlib.deflate zs inbuf 0 0 outbuf used_out (length - used_out) Zlib.Z_FINISH in
@@ -47,7 +47,7 @@ struct
let zs = Zlib.inflate_init header in
let (_, _(*used_in*), used_out) = Zlib.inflate zs inbuf 0 length outbuf 0 length Zlib.Z_SYNC_FLUSH in
let rec aux first finished used_out =
- Base.jlog (Printf.sprintf "aux_uncompr: used_out = %d" used_out) ;
+ Printf.eprintf "aux_uncompr: used_out = %d\n" used_out;
if finished then used_out
else
let dummy_byte = if first && not header then 1 else 0 in
@@ -235,16 +235,16 @@ struct
(** lecture de l OCTETS *)
let read t =
let p = pos_in t.ff in
-(* Base.jlog (Printf.sprintf "read PRE current=%d t.pos=%d t.endpos=%d t.offset=%d" p t.pos t.endpos t.offset) ; *)
+(* Printf.eprintf "read PRE current=%d t.pos=%d t.endpos=%d t.offset=%d\n" p t.pos t.endpos t.offset ; *)
let n = input t.ff t.b 0 t.buffer_size in
(* if n = 0 then Base.warning "Read.read: unexpected end of file. Perhaps a wrong path to a file?" ; *)
t.pos <- p ;
t.offset <- 0 ;
t.endpos <- p + n - 1
-(* Base.jlog (Printf.sprintf "read POST current=%d t.pos=%d t.endpos=%d t.offset=%d" p t.pos t.endpos t.offset) *)
- (* Base.jlog "read done" *)
+(* Printf.eprintf "read POST current=%d t.pos=%d t.endpos=%d t.offset=%d\n" p t.pos t.endpos t.offset *)
+ (* Printf.eprintf "read done" *)
let seek t p =
-(* Base.jlog (Printf.sprintf "seek pos=%d t.pos=%d t.endpos=%d t.offset=%d" p t.pos t.endpos t.offset) ; *)
+(* Printf.eprintf "seek pos=%d t.pos=%d t.endpos=%d t.offset=%d\n" p t.pos t.endpos t.offset ; *)
seek_in t.ff p ;
if p < t.pos or p > t.endpos then read t
else t.offset <- p - t.pos
View
8 libqmlcompil/dbGen/schema_private.ml
@@ -71,8 +71,6 @@ module PathMap = BaseMap.Make
let internal_error fmt = OManager.i_error fmt
-let sch_warn s = Base.jlog ~color:`magenta ("Database Warning: " ^ s)
-
let (@*) = InfixOperator.(@*)
type t = SchemaGraphLib.SchemaGraph0.t
@@ -172,7 +170,7 @@ let rec manage_pervasive_type ~context t gamma n =
let t = insert_multi t ~key_kind:kind ~multi_type:tymap n in
Some (t, Some n)
with Failure "key_kind" ->
- QmlError.warning ~wclass:WarningClass.dbgen_schema context
+ QmlError.warning ~wclass:WarningClass.dbgen_schema context
"@[<2>this kind of @{<bright>map@} is not handled by the database,@ elements won't be reachable directly@ (at %s)@]"
(SchemaGraphLib.string_path_of_node t n)
;
@@ -196,7 +194,9 @@ let rec manage_pervasive_type ~context t gamma n =
| _ -> false) ->
manage_tymap n ty1 ty2
| _ ->
- Base.jlog (Printf.sprintf "Warning: this map uses an ordering that is unsupported by the database.\nAccess to elements by key will be disabled (at %s)" (SchemaGraphLib.string_path_of_node t n));
+ QmlError.warning ~wclass:WarningClass.dbgen_schema context
+ "This map uses an ordering that is unsupported by the database.\nAccess to elements by key will be disabled (at %s)"
+ (SchemaGraphLib.string_path_of_node t n);
None)
| Q.TypeName ([],tid) when Q.TypeIdent.to_string tid = "binary" ->
let t, _n = SchemaGraphLib.set_node_label t n (C.Leaf C.Leaf_binary) in
View
23 libtrx/pgrammar.ml
@@ -36,10 +36,10 @@ module P = T.PreGrammar
exception GrammarParse of string
exception GrammarCheck of string
-(* let parse_ok text = *)
-(* match Trxparse.parse `Grammar text empty_pre_grammar true with *)
-(* | Some (lastp, _) -> Some lastp *)
-(* | _ -> None *)
+(* TODO: change this printf *)
+let log fmt =
+ Printf.eprintf (fmt^^"\n")
+
(* FIXME: déséquilibre file / input *)
(* FIXME: les extra des include sont ajoutés !!! *)
@@ -51,7 +51,6 @@ let find_file f =
let module_name_of_name n =
let chop s = File.chop_extension s in
- (*jlog (sprintf "n=%s basename=%s" n (Filename.basename n)) ;*)
String.capitalize (chop (Filename.basename n))
let add_globals pg cur_mod new_mod =
@@ -94,13 +93,13 @@ let parse_pre_grammar ?(name="Main") ?(stoppable=false) ~verbose input =
if StringSet.mem name !already_read then
pg
else begin
- if verbose then B.jlog ~color:`yellow (B.sprintf "parsing %s (stoppable:%b)" name stoppable);
+ if verbose then log "parsing %s (stoppable:%b)" name stoppable;
let input_len = String.length input in
let result =
try
let lastp, pg = Trxparse.parse_trxparse_grammar pg name (module_name_of_name module_name) stoppable input in
if lastp = input_len then begin
- if verbose then B.jlog ~color:`green (B.sprintf "(%s) read %d/%d bytes" name lastp input_len);
+ if verbose then log "(%s) read %d/%d bytes" name lastp input_len;
StringMap.fold (
fun x include_def pg ->
let pg = { pg with P.incl = StringMap.remove x pg.P.incl } in
@@ -123,7 +122,7 @@ let parse_pre_grammar ?(name="Main") ?(stoppable=false) ~verbose input =
end
in
let pg = load T.empty_pre_grammar input name name in
- B.jlog ~level:2 "parse_pre_grammar: end" ;
+ (*log "parse_pre_grammar: end" ;*)
pg
let read_pre_grammar ?stoppable ~verbose name = parse_pre_grammar ?stoppable ~verbose ~name (File.content name)
@@ -188,7 +187,7 @@ let dependencies pg =
StringMap.map (fun (def,_msg_error) -> dep_of_expression StringSet.empty (T.get_expression def)) pg
let grammar_error s =
- B.jlog ~color:`red s;
+ log "[31m%s[0m" s;
exit 2
let grammar_analysis pg =
@@ -492,7 +491,7 @@ let parse_grammar ?(name="Main") ?stoppable ?memo_default ?(unfold_starplus=true
let list_start ~verbose name =
let pg = read_pre_grammar ~verbose name in
let stdefs = start_definitions pg.P.defs in
- List.iter (fun s -> B.jlog s) stdefs
+ List.iter (fun s -> log "%s" s) stdefs
(* FIXME: only the grammar *)
let output_binary_grammar ~verbose ?(input="trxparse.trx") ?start output_file =
@@ -503,9 +502,9 @@ let output_binary_grammar ~verbose ?(input="trxparse.trx") ?start output_file =
let input_binary_grammar input_file =
let ic = open_in input_file in
- B.jlog "input_binary_grammar: begin" ;
+ log "input_binary_grammar: begin" ;
let (grammar:'a T.grammar) = input_value ic in
- B.jlog "input_binary_grammar: end" ;
+ log "input_binary_grammar: end" ;
close_in ic ;
grammar
View
4 libtrx/tgrammar.ml
@@ -269,14 +269,14 @@ let empty_pre_grammar =
(* pour le traitement des includes, on n'ajoute que si nécessaire *)
let add_definition preg (name, def) =
if StringMap.mem name preg.P.defs then
- ( B.jlog ~level:2 (B.sprintf "definition %s exists, skipping" name) ; preg)
+ ((* Printf.eprintf "definition %s exists, skipping\n" name ;*) preg)
else
{ preg with P.defs = StringMap.add name def preg.P.defs }
(* FIXME: factoriser *)
let add_function preg (name, def) =
if StringMap.mem name preg.P.funs then
- ( B.jlog ~level:2 (B.sprintf "function %s exists, skipping" name) ; preg)
+ ((* Printf.eprintf "function %s exists, skipping\n" name ;*) preg)
else
{ preg with P.funs = StringMap.add name def preg.P.funs }
View
2  libtrx/trxparse.trx
@@ -61,7 +61,7 @@ maybe_GElems_no_sp_eof <- maybe_GElems_no_sp EOF ;
/** TRX rule **/
Definition <- SEMI? rule_annots:annots KEEP_CACHE?:cache DEBUG?:debug MARK?:mark Identifier:id Type?:rtype DefExpr:expr SEMI?
- {{ jlog ~level:2 (sprintf "definition: %s" id) ;
+ {{ (*jlog ~level:2 (sprintf "definition: %s" id) ;*)
let entry =
{ PG.expression = expr
; debug = debug <> None
View
5 opa/passes.ml
@@ -670,13 +670,12 @@ let macro_pass_CompilationSuccess ((options:opa_options), _) =
(* let exe = Filename.basename options.OpaEnv.target in *)
let target_exe = options.OpaEnv.target in
let exe_path = if Filename.is_relative target_exe then Filename.concat cwd target_exe else target_exe in
- Base.jlog ~color:`green (Printf.sprintf "Compilation is ok, result is current directory : %s" exe_path); flush stderr;
+ OManager.printf "@{<green>Compilation is ok, result is current directory : %s@}" exe_path; flush stderr;
0
let macro_pass_CompilationFailure _ =
flush stderr; flush stdout;
- Base.jlog ~color:`red "\nInternal compiler error : Ocaml Compilation Failed";
- 1
+ OManager.i_error "Ocaml Compilation Failed"
let pass_resolve_remote_calls ~options (env:'tmp_env env_Gen_sliced) =
View
6 opabsl/mlbsl/badoplink.ml
@@ -105,16 +105,16 @@ let abort_transaction k =
##register [opacapi;restricted:dbgen] jlog: string -> void
-let jlog s = Base.jlog ~color:`magenta s
+let jlog s = Logger.info "%s" s
-let debug __s = #<If:DEBUG_DB> jlog __s #<End>
+let debug __s = #<If:DEBUG_DB> Logger.log ~color:`magenta __s #<End>
##register [opacapi;restricted:dbgen,cps-bypass] error: string, continuation('a) -> void
let error s k =
error s; abort_transaction @> k
##register [opacapi;restricted:dbgen] fatal_error \ fatal_error_for_dbgen: string, string, string -> 'a
-let fatal_error_for_dbgen = fun s1 s2 s3 -> Base.jlog (s1^s2^s3); BslSys.do_exit 1
+let fatal_error_for_dbgen = fun s1 s2 s3 -> Logger.critical "%s%s%s" s1 s2 s3; BslSys.do_exit 1
(* let wrap_option : 'a_option BslCps.continuation -> 'a Dblib.answer -> unit = fun k a -> match a with *)
(* | `Answer x -> qmlreturn k (qml_some x) *)
View
3  opabsl/mlbsl/bool.ml
@@ -23,9 +23,6 @@
(* register _and\Pervasives.(&&) : bool -> bool -> bool *)
-##register jlog : string -> void
-let jlog s = Base.jlog s
-
##register _and : bool, bool -> bool
let _and = ( && )
View
3  opabsl/mlbsl/bslCps.ml
@@ -133,8 +133,7 @@ let loop_schedule _ = Scheduler.run BslScheduler.opa
using them, without changing its semantic without --cps mode *)
##module Notcps_compatibility
- let jlog = fun s -> Base.jlog ~color:`magenta s
- let fatal_error = fun s -> jlog s; BslSys.do_exit 1
+ let fatal_error = fun s -> Logger.critical "%s" s; BslSys.do_exit 1
##register [no-projection, restricted : cps] dummy_cont : continuation(void)
let dummy_cont = QmlCpsServerLib.cont_ml (fun x -> x)
View
3  opabsl/mlbsl/bslPervasives.ml
@@ -152,8 +152,7 @@ let warning s =
##register jlog : string -> void
let jlog s =
sync_to_print_on stderr;
- #<If:TESTING> Printf.eprintf "%s\n%!" s #<Else> Base.jlog ~long:true s #<End>
- (*Base.jlog ~long:true s*)
+ #<If:TESTING> Logger.log "%s" s #<Else> Logger.info "%s" s #<End>
(**
* Type-unsafe identity.
View
36 teerex/trx_interpreter.ml
@@ -28,6 +28,10 @@ module P = Tgrammar.PreGrammar
let pr = Printf.sprintf
+(* TODO: change this printf *)
+let log fmt =
+ Printf.eprintf (fmt^^"\n")
+
let grammar_to_string g =
pr "Start: {%s}\nProductions:\n%s\n" g.T.start
(T.def_map_to_string (StringMap.map fst g.T.grammar))
@@ -337,18 +341,18 @@ let parse peg input =
let rec try_parse print_success = function
| [] -> None
| s::ss ->
- jlog ~level:2 (pr "Trying to parse with the start production: %s" s);
+ (*jlog ~level:2 (pr "Trying to parse with the start production: %s" s);*)
match parse_definition s 0 with
| Fail e ->
let err_str = show_parse_error (FilePos.get_pos_no_cache input) e in
- jlog (pr "Production %s gives syntax error: %s" s err_str);
+ log "Production %s gives syntax error: %s" s err_str;
try_parse print_success ss
| Ok ((pos, _), _e) ->
if print_success then
- jlog (pr "Success with: %s" s);
+ log "Success with: %s" s;
Some pos
in
- jlog ~level:3 (pr "Parsing with the following grammar:\n%s\n======\n" (grammar_to_string peg));
+ (*jlog ~level:3 (pr "Parsing with the following grammar:\n%s\n======\n" (grammar_to_string peg));*)
match !startProd with
| None -> try_parse true (Pgrammar.start_definitions peg.T.grammar)
| Some s -> try_parse false [s]
@@ -414,27 +418,27 @@ let load_grammar grammarFn =
peg
let parse_file peg inputFn =
- jlog (pr "Parsing <%s>..." inputFn);
+ log "Parsing <%s>..." inputFn;
let input = File.content inputFn in
let all = String.length input in
let go () = parse peg input in
let res, t = measureTime go in
begin match res with
| Some pos ->
- jlog (pr "Parsing successful [%d/%d] in %4.2fsec." pos all t)
+ log "Parsing successful [%d/%d] in %4.2fsec." pos all t
| None ->
- jlog "Parsing failed"
+ log "Parsing failed"
end;
begin match !traceFile with
| None -> ()
| Some fn ->
write_trace input (open_out fn);
- jlog (pr "Parsing trace written to <%s>" fn)
+ log "Parsing trace written to <%s>" fn
end
let parse_files peg inputFn =
let inc = open_in inputFn in
- jlog (pr "Parsing all files from <%s>" inputFn);
+ log "Parsing all files from <%s>" inputFn;
let n = ref 0 in
let go () =
try
@@ -448,7 +452,7 @@ let parse_files peg inputFn =
close_in inc
in
let _, t = measureTime go in
- jlog (pr "Total time of parsing %d files from <%s>: %4.2fsec." !n inputFn t)
+ log "Total time of parsing %d files from <%s>: %4.2fsec." !n inputFn t
let parsing peg =
let inputFn = get_input_fn () in
@@ -490,7 +494,7 @@ let analyze_memo peg =
let _, t = parseWithPeg peg' in
progress ();
if false then
- jlog ~level:2 (pr "Trying to change memo option for def. <%s> to <%s> gives time: %4.3fsec." def_name (memo2str memo_opt) t);
+ (*jlog ~level:2 (pr "Trying to change memo option for def. <%s> to <%s> gives time: %4.3fsec." def_name (memo2str memo_opt) t);*)
if t < best then
(Some move, t)
else
@@ -506,22 +510,22 @@ let analyze_memo peg =
let res, best' = StringMap.fold (try_to_improve peg) peg.T.grammar (None, best) in
match res with
| None ->
- jlog (pr "\nNo improvement...")
+ log "\nNo improvement..."
| Some move ->
let impr = best -. best' in
- jlog (pr "\nConsider changing memoization option for definition <%s> to <%s>.\nIt resulted in time %4.3fsec. (%4.3fsec./%1.3f%% improvement)"
- (fst move) (memo2str (snd move)) best' impr (100.0 *. impr /. best));
+ log "\nConsider changing memoization option for definition <%s> to <%s>.\nIt resulted in time %4.3fsec. (%4.3fsec./%1.3f%% improvement)"
+ (fst move) (memo2str (snd move)) best' impr (100.0 *. impr /. best);
improve (best', apply_move move peg)
in
let _, best = parseWithPeg peg in
- jlog (pr "Initial grammar gives timing: %4.3fsec. [no. of rules: %d]" best (StringMap.size peg.T.grammar));
+ log "Initial grammar gives timing: %4.3fsec. [no. of rules: %d]" best (StringMap.size peg.T.grammar);
improve (best, peg)
let _ =
parse_args ();
let grammarFn = get_grammar_fn () in
let inputFn = get_input_fn () in
- jlog (pr "Loading grammar from {%s} and then parsing {%s}\n" grammarFn inputFn);
+ log "Loading grammar from {%s} and then parsing {%s}\n" grammarFn inputFn;
try
let peg = load_grammar grammarFn in
match !cmd with
View
32 teerex/trx_ocaml.ml
@@ -29,6 +29,9 @@ module OcamlG = Ocaml.Cons
let pr = Printf.sprintf
let prErr = Printf.eprintf
+let log fmt = Printf.eprintf (fmt^^"\n")
+let error fmt = Printf.eprintf (""^^fmt^^"\n")
+
(* we count parts of the sequence starting from 1 (they can be accessed in semantic
actions via __1, __2 etc. variables *)
let first_pos = 1
@@ -768,7 +771,7 @@ let rec generate_exp ctx = function
and generate_seq ctx (items, map, code) =
(* if there is no provided [code] and there is only one part of the sequence that
can be used as a result - use it *)
- jlog ~color:`green ~level:3 (pr "generate_seq [gen_err: %b]" ctx.gen_err);
+(* jlog ~color:`green ~level:3 (pr "generate_seq [gen_err: %b]" ctx.gen_err);*)
(* We substitute proper variables into [_pos_beg] and [_pos_end] variables,
* substitute for positional variables (named parts of a sequence and catch
* exceptions thrown from productions' code.
@@ -984,7 +987,7 @@ and generate_primary ctx = function
| P.Ident id ->
let pf = parsing_function ctx.gen_err id in
G.add_edge dep_g !generated_prod pf;
- jlog ~color:`green ~level:3 (pr "Function dependency: %s --> %s" !generated_prod pf);
+ (*jlog ~color:`green ~level:3 (pr "Function dependency: %s --> %s" !generated_prod pf);*)
call_fun (List.map var (pf :: grammar_extras ctx.peg @ [main_param_filename; main_param_text; ctx.input]))
| P.Paren exp ->
generate_exp ctx exp
@@ -1034,7 +1037,7 @@ let funPreliminaries () =
let generate_prod peg gen_err (name, (def, annots)) =
let funName = parsing_function gen_err name in
- jlog ~color:`green ~level:3 (pr "Generating function: %s [gen_err: %b]" funName gen_err);
+ (*jlog ~color:`green ~level:3 (pr "Generating function: %s [gen_err: %b]" funName gen_err);*)
G.add_vertex dep_g funName;
generated_prod := funName;
let inputVar = "input" in
@@ -1397,9 +1400,9 @@ let optimize_memoization peg =
else
n, (def, annots)
in
- let n, g = StringMap.fold_map optimize_rule peg.T.grammar 0 in
- jlog ~color:`green ~level:2 (pr "Turning off memoization for %d (out of the total of %d) trivial rules"
- n (StringMap.size peg.T.grammar));
+ let _n, g = StringMap.fold_map optimize_rule peg.T.grammar 0 in
+ (*jlog ~color:`green ~level:2 (pr "Turning off memoization for %d (out of the total of %d) trivial rules"
+ n (StringMap.size peg.T.grammar));*)
{ peg with T.grammar = g }
(* =========================================================================================================== *)
@@ -1501,7 +1504,8 @@ let set_bool_option opt v var =
| "true" -> var := true
| "false" -> var := false
| _ ->
- jlog ~color:`red (pr "Unknown value in the grammar for the boolean option <%s=%s> (should be 'false' or 'true')" opt v); exit 2
+ (error "Unknown value in the grammar for the boolean option <%s=%s> (should be 'false' or 'true')" opt v;
+ exit 2)
let rec process_options opts =
let process_option (opt, v) =
@@ -1513,7 +1517,7 @@ let rec process_options opts =
| "imperative-errors" -> set_bool imperative_errors
| "memoization" -> () (* This option is taken care of in Pgrammar.read_grammar *)
| _ ->
- jlog ~color:`red (pr "Unknown option in the grammar file: <%s=%s>" opt v); exit 2
+ (error "Unknown option in the grammar file: <%s=%s>" opt v; exit 2)
in
match opts with
| [] -> ()
@@ -1521,8 +1525,8 @@ let rec process_options opts =
process_option x;
process_options xs
-let print_options () =
- let memo2str = function
+let print_options () = ()
+ (*let memo2str = function
| None -> "unspecified (defaults to 'success' unless overriten in the grammar)"
| Some T.MemoNone -> "none"
| Some T.MemoFail -> "fail"
@@ -1544,7 +1548,7 @@ let print_options () =
--auto--ast = %b%s\n"
!incremental !imperative_errors !opt_errors !opt_gen_res !opt_inline_literals
!opt_inline_ranges !debug_mode !functorize !auto_ast
- (memoOpt2str "memoization" memo_default))
+ (memoOpt2str "memoization" memo_default))*)
let non_verbose f =
let res = f () in
@@ -1553,8 +1557,8 @@ let non_verbose f =
let is_verbose () = false
let print_start_prods peg =
- jlog ~color:`green "Start productions:";
- let print_prod p = jlog ~color:`green (pr " > %s" p) in
+ log "Start productions:";
+ let print_prod p = log " > %s" p in
List.iter print_prod (Pgrammar.start_definitions peg.T.grammar)
let write_to_file fn code =
@@ -1584,7 +1588,7 @@ let _ =
| Some s -> s
in
let fn_ml, fn_mli = baseName ^ ".ml", baseName ^ ".mli" in
- jlog ~color:`green ~level:2 (pr "TRX applied to grammar {%s} will generate code in {%s} and interface in {%s} " grammarFn fn_ml fn_mli);
+ (*jlog ~color:`green ~level:2 (pr "TRX applied to grammar {%s} will generate code in {%s} and interface in {%s} " grammarFn fn_ml fn_mli);*)
let read () = Pgrammar.read_grammar ?memo_default:!memo_default ~verbose:(is_verbose ()) ~unfold_starplus:!opt_unfold_starplus None grammarFn in
let peg, _used = non_verbose read in
let peg = optimize_memoization peg in
Please sign in to comment.
Something went wrong with that request. Please try again.