user0/rust
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add -lpath mechanism for logging only a subset of a pass (by module-path prefix)

Browse source
This commit is contained in:
Graydon Hoare 2010-10-08 14:54:51 -07:00
parent e3758fe321
commit 5f2459145c
15 changed files with 142 additions and 103 deletions
Download patch file Download diff file Expand all files Collapse all files

5
src/boot/driver/main.ml
View file

@ -51,6 +51,7 @@ let (sess:Session.sess) =
Session.sess_log_asm = false;
Session.sess_log_obj = false;
Session.sess_log_lib = false;
Session.sess_log_path = None;
Session.sess_log_out = stdout;
Session.sess_log_err = stderr;
Session.sess_trace_block = false;
@ -199,6 +200,10 @@ let argspecs =
(flag (fun _ -> sess.Session.sess_log_lib <- true)
"-llib" "log library search");
("-lpath", Arg.String
(fun s -> sess.Session.sess_log_path <- Some (split_string '.' s)),
"module path to restrict logging to");
(flag (fun _ -> sess.Session.sess_trace_block <- true)
"-tblock" "emit block-boundary tracing code");
(flag (fun _ -> sess.Session.sess_trace_drop <- true)

1
src/boot/driver/session.ml
View file

@ -37,6 +37,7 @@ type sess =
mutable sess_log_asm: bool;
mutable sess_log_obj: bool;
mutable sess_log_lib: bool;
mutable sess_log_path: (string list) option;
mutable sess_log_out: out_channel;
mutable sess_log_err: out_channel;
mutable sess_trace_block: bool;

5
src/boot/me/alias.ml
View file

@ -2,7 +2,7 @@ open Semant;;
open Common;;
let log cx = Session.log "alias"
cx.ctxt_sess.Session.sess_log_alias
(should_log cx cx.ctxt_sess.Session.sess_log_alias)
cx.ctxt_sess.Session.sess_log_out
;;
@ -110,14 +110,13 @@ let process_crate
(cx:ctxt)
(crate:Ast.crate)
: unit =
let path = Stack.create () in
let passes =
[|
(alias_analysis_visitor cx
Walk.empty_visitor);
|]
in
run_passes cx "alias" path passes
run_passes cx "alias" passes
cx.ctxt_sess.Session.sess_log_alias log crate
;;

5
src/boot/me/dead.ml
View file

@ -7,7 +7,7 @@ open Semant;;
open Common;;
let log cx = Session.log "dead"
cx.ctxt_sess.Session.sess_log_dead
(should_log cx cx.ctxt_sess.Session.sess_log_dead)
cx.ctxt_sess.Session.sess_log_out
;;
@ -99,7 +99,6 @@ let process_crate
(cx:ctxt)
(crate:Ast.crate)
: unit =
let path = Stack.create () in
let passes =
[|
(dead_code_visitor cx
@ -107,7 +106,7 @@ let process_crate
|]
in
run_passes cx "dead" path passes
run_passes cx "dead" passes
cx.ctxt_sess.Session.sess_log_dead log crate;
()
;;

13
src/boot/me/dwarf.ml
View file

@ -66,7 +66,7 @@ open Common;;
open Asm;;
let log cx = Session.log "dwarf"
cx.ctxt_sess.Session.sess_log_dwarf
(should_log cx cx.ctxt_sess.Session.sess_log_dwarf)
cx.ctxt_sess.Session.sess_log_out
;;
@ -1425,7 +1425,6 @@ let prepend lref x = lref := x :: (!lref)
let dwarf_visitor
(cx:ctxt)
(inner:Walk.visitor)
(path:Ast.name_component Stack.t)
(cu_info_section_fixup:fixup)
(cu_aranges:(frag list) ref)
(cu_pubnames:(frag list) ref)
@ -1454,7 +1453,9 @@ let dwarf_visitor
| Il.Bits64 -> TY_i64
in
let path_name _ = Fmt.fmt_to_str Ast.fmt_name (path_to_name path) in
let path_name _ =
Fmt.fmt_to_str Ast.fmt_name (path_to_name cx.ctxt_curr_path)
in
let (abbrev_table:(abbrev, int) Hashtbl.t) = Hashtbl.create 0 in
@ -2485,12 +2486,10 @@ let process_crate
let cu_lines = ref [] in
let cu_frames = ref [] in
let path = Stack.create () in
let passes =
[|
unreferenced_required_item_ignoring_visitor cx
(dwarf_visitor cx Walk.empty_visitor path
(dwarf_visitor cx Walk.empty_visitor
cx.ctxt_debug_info_fixup
cu_aranges cu_pubnames
cu_infos cu_abbrevs
@ -2499,7 +2498,7 @@ let process_crate
in
log cx "emitting DWARF records";
run_passes cx "dwarf" path passes
run_passes cx "dwarf" passes
cx.ctxt_sess.Session.sess_log_dwarf log crate;
(* Terminate the tables. *)

7
src/boot/me/effect.ml
View file

@ -2,12 +2,12 @@ open Semant;;
open Common;;
let log cx = Session.log "effect"
cx.ctxt_sess.Session.sess_log_effect
(should_log cx cx.ctxt_sess.Session.sess_log_effect)
cx.ctxt_sess.Session.sess_log_out
;;
let iflog cx thunk =
if cx.ctxt_sess.Session.sess_log_effect
if (should_log cx cx.ctxt_sess.Session.sess_log_effect)
then thunk ()
else ()
;;
@ -315,7 +315,6 @@ let process_crate
(cx:ctxt)
(crate:Ast.crate)
: unit =
let path = Stack.create () in
let item_auth = Hashtbl.create 0 in
let item_effect = Hashtbl.create 0 in
let passes =
@ -340,7 +339,7 @@ let process_crate
else err (Some id) "auth clause in crate refers to non-item"
in
Hashtbl.iter auth_effect crate.node.Ast.crate_auth;
run_passes cx "effect" path passes
run_passes cx "effect" passes
cx.ctxt_sess.Session.sess_log_effect log crate
;;

7
src/boot/me/layout.ml
View file

@ -2,7 +2,7 @@ open Semant;;
open Common;;
let log cx = Session.log "layout"
cx.ctxt_sess.Session.sess_log_layout
(should_log cx cx.ctxt_sess.Session.sess_log_layout)
cx.ctxt_sess.Session.sess_log_out
;;
@ -128,7 +128,7 @@ let layout_visitor
in
let iflog thunk =
if cx.ctxt_sess.Session.sess_log_layout
if (should_log cx cx.ctxt_sess.Session.sess_log_layout)
then thunk ()
else ()
in
@ -453,14 +453,13 @@ let process_crate
(cx:ctxt)
(crate:Ast.crate)
: unit =
let path = Stack.create () in
let passes =
[|
(layout_visitor cx
Walk.empty_visitor)
|];
in
run_passes cx "layout" path passes
run_passes cx "layout" passes
cx.ctxt_sess.Session.sess_log_layout log crate
;;

5
src/boot/me/loop.ml
View file

@ -6,7 +6,7 @@ open Semant;;
open Common;;
let log cx = Session.log "loop"
cx.ctxt_sess.Session.sess_log_loop
(should_log cx cx.ctxt_sess.Session.sess_log_loop)
cx.ctxt_sess.Session.sess_log_out
;;
@ -142,7 +142,6 @@ let process_crate
(cx:ctxt)
(crate:Ast.crate)
: unit =
let path = Stack.create () in
let passes =
[|
(loop_depth_visitor cx
@ -150,7 +149,7 @@ let process_crate
|]
in
run_passes cx "loop" path passes
run_passes cx "loop" passes
cx.ctxt_sess.Session.sess_log_loop log crate
;;

22
src/boot/me/resolve.ml
View file

@ -16,12 +16,12 @@ open Common;;
let log cx = Session.log "resolve"
cx.ctxt_sess.Session.sess_log_resolve
(should_log cx cx.ctxt_sess.Session.sess_log_resolve)
cx.ctxt_sess.Session.sess_log_out
;;
let iflog cx thunk =
if cx.ctxt_sess.Session.sess_log_resolve
if (should_log cx cx.ctxt_sess.Session.sess_log_resolve)
then thunk ()
else ()
;;
@ -139,7 +139,6 @@ let stmt_collecting_visitor
let all_item_collecting_visitor
(cx:ctxt)
(path:Ast.name_component Stack.t)
(inner:Walk.visitor)
: Walk.visitor =
@ -169,7 +168,7 @@ let all_item_collecting_visitor
Array.iter (fun p -> htab_put cx.ctxt_all_defns p.id
(DEFN_ty_param p.node)) p;
htab_put cx.ctxt_all_defns i.id (DEFN_item i.node);
htab_put cx.ctxt_all_item_names i.id (path_to_name path);
htab_put cx.ctxt_all_item_names i.id (path_to_name cx.ctxt_curr_path);
log cx "collected item #%d: %s" (int_of_node i.id) n;
begin
match i.node.Ast.decl_item with
@ -191,14 +190,14 @@ let all_item_collecting_visitor
let visit_obj_fn_pre obj ident fn =
htab_put cx.ctxt_all_defns fn.id (DEFN_obj_fn (obj.id, fn.node));
htab_put cx.ctxt_all_item_names fn.id (path_to_name path);
htab_put cx.ctxt_all_item_names fn.id (path_to_name cx.ctxt_curr_path);
note_header fn.id fn.node.Ast.fn_input_slots;
inner.Walk.visit_obj_fn_pre obj ident fn
in
let visit_obj_drop_pre obj b =
htab_put cx.ctxt_all_defns b.id (DEFN_obj_drop obj.id);
htab_put cx.ctxt_all_item_names b.id (path_to_name path);
htab_put cx.ctxt_all_item_names b.id (path_to_name cx.ctxt_curr_path);
inner.Walk.visit_obj_drop_pre obj b
in
@ -210,7 +209,7 @@ let all_item_collecting_visitor
htab_put cx.ctxt_all_defns id
(DEFN_loop_body (Stack.top items));
htab_put cx.ctxt_all_item_names id
(path_to_name path);
(path_to_name cx.ctxt_curr_path);
| _ -> ()
end;
inner.Walk.visit_stmt_pre s;
@ -822,13 +821,12 @@ let process_crate
(crate:Ast.crate)
: unit =
let (scopes:(scope list) ref) = ref [] in
let path = Stack.create () in
let passes_0 =
[|
(block_scope_forming_visitor cx Walk.empty_visitor);
(stmt_collecting_visitor cx
(all_item_collecting_visitor cx path
(all_item_collecting_visitor cx
Walk.empty_visitor));
|]
in
@ -852,11 +850,11 @@ let process_crate
in
let log_flag = cx.ctxt_sess.Session.sess_log_resolve in
log cx "running primary resolve passes";
run_passes cx "resolve collect" path passes_0 log_flag log crate;
run_passes cx "resolve collect" passes_0 log_flag log crate;
log cx "running secondary resolve passes";
run_passes cx "resolve bind" path passes_1 log_flag log crate;
run_passes cx "resolve bind" passes_1 log_flag log crate;
log cx "running tertiary resolve passes";
run_passes cx "resolve patterns" path passes_2 log_flag log crate;
run_passes cx "resolve patterns" passes_2 log_flag log crate;
iflog cx
begin

87
src/boot/me/semant.ml
View file

@ -183,6 +183,9 @@ type ctxt =
ctxt_main_fn_fixup: fixup option;
ctxt_main_name: Ast.name option;
(* Dynamically changes while walking. See path_managing_visitor. *)
ctxt_curr_path: Ast.name_component Stack.t;
}
;;
@ -270,9 +273,47 @@ let new_ctxt sess abi crate =
| Some n -> Some (new_fixup (string_of_name n)));
ctxt_main_name = crate.Ast.crate_main;
ctxt_curr_path = Stack.create ();
}
;;
let rec name_of ncs =
match ncs with
[] -> bug () "Walk.name_of_ncs: empty path"
| [(Ast.COMP_ident i)] -> Ast.NAME_base (Ast.BASE_ident i)
| [(Ast.COMP_app x)] -> Ast.NAME_base (Ast.BASE_app x)
| [(Ast.COMP_idx _)] ->
bug () "Walk.name_of_ncs: path-name contains COMP_idx"
| nc::ncs -> Ast.NAME_ext (name_of ncs, nc)
;;
let path_to_name
(path:Ast.name_component Stack.t)
: Ast.name =
name_of (stk_elts_from_top path)
;;
let should_log cx flag =
if flag
then
match cx.ctxt_sess.Session.sess_log_path with
None -> false
| Some mask ->
let curr = stk_elts_from_bot cx.ctxt_curr_path in
let rec permitted ncs strs =
match (ncs, strs) with
((Ast.COMP_ident s) :: ncs, str :: strs)
| ((Ast.COMP_app (s, _)) :: ncs, str :: strs)
when s = str ->
permitted ncs strs
| (_, []) -> true
| _ -> false
in
(permitted curr mask)
else
false
;;
let bugi (cx:ctxt) (i:node_id) =
let k s =
@ -1693,74 +1734,57 @@ let unreferenced_required_item_ignoring_visitor
Walk.visit_obj_drop_post = visit_obj_drop_post; }
;;
let rec name_of ncs =
match ncs with
[] -> bug () "Walk.name_of_ncs: empty path"
| [(Ast.COMP_ident i)] -> Ast.NAME_base (Ast.BASE_ident i)
| [(Ast.COMP_app x)] -> Ast.NAME_base (Ast.BASE_app x)
| [(Ast.COMP_idx _)] ->
bug () "Walk.name_of_ncs: path-name contains COMP_idx"
| nc::ncs -> Ast.NAME_ext (name_of ncs, nc)
;;
let path_to_name
(path:Ast.name_component Stack.t)
: Ast.name =
name_of (stk_elts_from_top path)
;;
let mod_item_logging_visitor
(cx:ctxt)
(log_flag:bool)
(log:ctxt -> ('a, unit, string, unit) format4 -> 'a)
(pass:int)
(path:Ast.name_component Stack.t)
(inner:Walk.visitor)
: Walk.
visitor =
let entering _ =
if cx.ctxt_sess.Session.sess_log_passes
if (should_log cx cx.ctxt_sess.Session.sess_log_passes)
then
Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
"pass %d: entering %a"
pass Ast.sprintf_name (path_to_name path);
pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path);
if log_flag
then
log cx "pass %d: entering %a"
pass Ast.sprintf_name (path_to_name path)
pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path)
in
let entered _ =
if cx.ctxt_sess.Session.sess_log_passes
if (should_log cx cx.ctxt_sess.Session.sess_log_passes)
then
Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
"pass %d: entered %a"
pass Ast.sprintf_name (path_to_name path);
pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path);
if log_flag
then
log cx "pass %d: entered %a"
pass Ast.sprintf_name (path_to_name path)
pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path)
in
let leaving _ =
if cx.ctxt_sess.Session.sess_log_passes
if (should_log cx cx.ctxt_sess.Session.sess_log_passes)
then
Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
"pass %d: leaving %a"
pass Ast.sprintf_name (path_to_name path);
pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path);
if log_flag
then
log cx "pass %d: leaving %a"
pass Ast.sprintf_name (path_to_name path)
pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path)
in
let left _ =
if cx.ctxt_sess.Session.sess_log_passes
if (should_log cx cx.ctxt_sess.Session.sess_log_passes)
then
Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
"pass %d: left %a"
pass Ast.sprintf_name (path_to_name path);
pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path);
if log_flag
then
log cx "pass %d: left %a"
pass Ast.sprintf_name (path_to_name path)
pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path)
in
let visit_mod_item_pre name params item =
@ -2044,7 +2068,6 @@ let lookup
let run_passes
(cx:ctxt)
(name:string)
(path:Ast.name_component Stack.t)
(passes:Walk.visitor array)
(log_flag:bool)
(log:ctxt -> ('a, unit, string, unit) format4 -> 'a)
@ -2055,8 +2078,8 @@ let run_passes
then Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
"starting pass %s # %d" name i;
Walk.walk_crate
(Walk.path_managing_visitor path
(mod_item_logging_visitor cx log_flag log i path pass))
(Walk.path_managing_visitor cx.ctxt_curr_path
(mod_item_logging_visitor cx log_flag log i pass))
crate
in
let sess = cx.ctxt_sess in

7
src/boot/me/simplify.ml
View file

@ -4,11 +4,11 @@ open Semant;;
let log cx =
Session.log
"simplify"
cx.Semant.ctxt_sess.Session.sess_log_simplify
(should_log cx cx.Semant.ctxt_sess.Session.sess_log_simplify)
cx.Semant.ctxt_sess.Session.sess_log_out
let iflog cx thunk =
if cx.Semant.ctxt_sess.Session.sess_log_simplify
if (should_log cx cx.Semant.ctxt_sess.Session.sess_log_simplify)
then thunk ()
else ()
;;
@ -87,7 +87,6 @@ let pexp_simplifying_visitor
let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
let path = Stack.create () in
let passes =
[|
@ -96,7 +95,7 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
|]
in
let log_flag = cx.Semant.ctxt_sess.Session.sess_log_simplify in
Semant.run_passes cx "simplify" path passes log_flag log crate
Semant.run_passes cx "simplify" passes log_flag log crate
;;
(*

36
src/boot/me/trans.ml
View file

@ -5,7 +5,7 @@ open Common;;
open Transutil;;
let log cx = Session.log "trans"
cx.ctxt_sess.Session.sess_log_trans
(should_log cx cx.ctxt_sess.Session.sess_log_trans)
cx.ctxt_sess.Session.sess_log_out
;;
@ -45,12 +45,11 @@ type const =
let trans_visitor
(cx:ctxt)
(path:Ast.name_component Stack.t)
(inner:Walk.visitor)
: Walk.visitor =
let iflog thunk =
if cx.ctxt_sess.Session.sess_log_trans
if (should_log cx cx.ctxt_sess.Session.sess_log_trans)
then thunk ()
else ()
in
@ -237,7 +236,7 @@ let trans_visitor
let simple_break_jumps = Stack.create() in (* not used for for-each *)
let path_name (_:unit) : string =
string_of_name (path_to_name path)
string_of_name (path_to_name cx.ctxt_curr_path)
in
let based (reg:Il.reg) : Il.mem =
@ -3416,8 +3415,8 @@ let trans_visitor
drop_ty ty_params cell (slot_ty slot)
and note_drop_step ty step =
if cx.ctxt_sess.Session.sess_trace_drop ||
cx.ctxt_sess.Session.sess_log_trans
if (should_log cx (cx.ctxt_sess.Session.sess_trace_drop ||
cx.ctxt_sess.Session.sess_log_trans))
then
let mctrl_str =
match ty_mem_ctrl cx ty with
@ -3434,8 +3433,8 @@ let trans_visitor
end
and note_gc_step ty step =
if cx.ctxt_sess.Session.sess_trace_gc ||
cx.ctxt_sess.Session.sess_log_trans
if (should_log cx (cx.ctxt_sess.Session.sess_trace_gc ||
cx.ctxt_sess.Session.sess_log_trans))
then
let mctrl_str =
match ty_mem_ctrl cx ty with
@ -5561,7 +5560,7 @@ let trans_visitor
htab_search_or_add cx.ctxt_required_rust_sym_num fnid
(fun _ -> Hashtbl.length cx.ctxt_required_rust_sym_num)
in
let path_elts = stk_elts_from_bot path in
let path_elts = stk_elts_from_bot cx.ctxt_curr_path in
let _ =
assert (ls.required_prefix < (List.length path_elts))
in
@ -5591,7 +5590,8 @@ let trans_visitor
match htab_search cx.ctxt_required_syms fnid with
Some s -> s
| None ->
string_of_name_component (Stack.top path)
string_of_name_component
(Stack.top cx.ctxt_curr_path)
in
let c_sym_num =
(* FIXME: permit remapping symbol names to handle
@ -5935,12 +5935,11 @@ let trans_visitor
let fixup_assigning_visitor
(cx:ctxt)
(path:Ast.name_component Stack.t)
(inner:Walk.visitor)
: Walk.visitor =
let path_name (_:unit) : string =
Fmt.fmt_to_str Ast.fmt_name (path_to_name path)
Fmt.fmt_to_str Ast.fmt_name (path_to_name cx.ctxt_curr_path)
in
let enter_file_for id =
@ -5948,7 +5947,7 @@ let fixup_assigning_visitor
then
begin
let name =
if Stack.is_empty path
if Stack.is_empty cx.ctxt_curr_path
then "crate root"
else path_name()
in
@ -5969,7 +5968,7 @@ let fixup_assigning_visitor
| Ast.MOD_ITEM_fn _ ->
begin
let path = path_to_name path in
let path = path_to_name cx.ctxt_curr_path in
let fixup =
if (not cx.ctxt_sess.Session.sess_library_mode)
&& (Some path) = cx.ctxt_main_name
@ -6031,15 +6030,12 @@ let process_crate
(cx:ctxt)
(crate:Ast.crate)
: unit =
let path = Stack.create () in
let passes =
[|
(unreferenced_required_item_ignoring_visitor cx
(fixup_assigning_visitor cx path
Walk.empty_visitor));
(fixup_assigning_visitor cx Walk.empty_visitor));
(unreferenced_required_item_ignoring_visitor cx
(trans_visitor cx path
Walk.empty_visitor))
(trans_visitor cx Walk.empty_visitor))
|];
in
log cx "translating crate";
@ -6050,7 +6046,7 @@ let process_crate
log cx "with main fn %a"
Ast.sprintf_name m
end;
run_passes cx "trans" path passes
run_passes cx "trans" passes
cx.ctxt_sess.Session.sess_log_trans log crate;
;;

7
src/boot/me/type.ml
View file

@ -28,11 +28,11 @@ exception Type_error of string * string
let log cx =
Session.log
"type"
cx.Semant.ctxt_sess.Session.sess_log_type
(Semant.should_log cx cx.Semant.ctxt_sess.Session.sess_log_type)
cx.Semant.ctxt_sess.Session.sess_log_out
let iflog cx thunk =
if cx.Semant.ctxt_sess.Session.sess_log_type
if (Semant.should_log cx cx.Semant.ctxt_sess.Session.sess_log_type)
then thunk ()
else ()
;;
@ -1253,7 +1253,6 @@ let check_for_tag_cycles (cx:Semant.ctxt) =
Hashtbl.iter check_node cx.Semant.ctxt_tag_containment
let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
let path = Stack.create () in
let fn_ctx_stack = Stack.create () in
(* Verify that, if main is present, it has the right form. *)
@ -1393,7 +1392,7 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
|]
in
let log_flag = cx.Semant.ctxt_sess.Session.sess_log_type in
Semant.run_passes cx "type" path passes log_flag log crate
Semant.run_passes cx "type" passes log_flag log crate
;;
(*

13
src/boot/me/typestate.ml
View file

@ -3,12 +3,12 @@ open Common;;
let log cx = Session.log "typestate"
cx.ctxt_sess.Session.sess_log_typestate
(should_log cx cx.ctxt_sess.Session.sess_log_typestate)
cx.ctxt_sess.Session.sess_log_out
;;
let iflog cx thunk =
if cx.ctxt_sess.Session.sess_log_typestate
if (should_log cx cx.ctxt_sess.Session.sess_log_typestate)
then thunk ()
else ()
;;
@ -1590,7 +1590,6 @@ let process_crate
(cx:ctxt)
(crate:Ast.crate)
: unit =
let path = Stack.create () in
let (scopes:(scope list) ref) = ref [] in
let (tables_stack:typestate_tables Stack.t) = Stack.create () in
let (all_tables:item_tables) = Hashtbl.create 0 in
@ -1641,11 +1640,11 @@ let process_crate
|]
in
let log_flag = cx.ctxt_sess.Session.sess_log_typestate in
run_passes cx "typestate setup" path setup_passes log_flag log crate;
run_passes cx "typestate setup" setup_passes log_flag log crate;
run_passes cx
"typestate dataflow" path dataflow_passes log_flag log crate;
run_passes cx "typestate verify" path verify_passes log_flag log crate;
run_passes cx "typestate aux" path aux_passes log_flag log crate
"typestate dataflow" dataflow_passes log_flag log crate;
run_passes cx "typestate verify" verify_passes log_flag log crate;
run_passes cx "typestate aux" aux_passes log_flag log crate
;;

25
src/boot/util/common.ml
View file

@ -179,6 +179,31 @@ let new_fixup (s:string)
;;
(*
* Auxiliary string functions.
*)
let split_string (c:char) (s:string) : string list =
let ls = ref [] in
let b = Buffer.create (String.length s) in
let flush _ =
if Buffer.length b <> 0
then
begin
ls := (Buffer.contents b) :: (!ls);
Buffer.clear b
end
in
let f ch =
if c = ch
then flush()
else Buffer.add_char b ch
in
String.iter f s;
flush();
List.rev (!ls)
;;
(*
* Auxiliary hashtable functions.
*)