Commit 7617dc8e authored by Mário Pereira's avatar Mário Pereira
Browse files

Extraction: refactoring

parent c9be2cf3
...@@ -327,7 +327,7 @@ module Print = struct ...@@ -327,7 +327,7 @@ module Print = struct
else else
let ty_args = List.map (fun (_, ty, _) -> ty) args in let ty_args = List.map (fun (_, ty, _) -> ty) args in
let id_args = List.map (fun (id, _, _) -> id) args in let id_args = List.map (fun (id, _, _) -> id) args in
fprintf fmt ": @[@[%a@]. @[%a@] ->@ %a@ =@ @[fun @[%a@]@ ->@]@]" fprintf fmt ": @[@[%a@]. @[%a ->@ %a@] =@ @[fun @[%a@]@ ->@]@]"
print_svar s print_svar s
(print_list arrow (print_ty ~paren:true info)) ty_args (print_list arrow (print_ty ~paren:true info)) ty_args
(print_ty ~paren:true info) res (print_ty ~paren:true info) res
......
...@@ -273,13 +273,12 @@ let find_decl mm id = ...@@ -273,13 +273,12 @@ let find_decl mm id =
let m = translate_module m in let m = translate_module m in
Ident.Mid.find id m.Mltree.mod_known Ident.Mid.find id m.Mltree.mod_known
let rec visit mm id = let rec visit ~recurs mm id =
if not (Ident.Hid.mem visited id) then begin if not (Ident.Hid.mem visited id) then begin
try try
let d = find_decl mm id in let d = find_decl mm id in
Ident.Hid.add visited id (); Ident.Hid.add visited id ();
if opt_rec_single = Recursive then if recurs then ML.iter_deps (visit ~recurs mm) d;
ML.iter_deps (visit mm) d;
toextract := id :: !toextract toextract := id :: !toextract
with Not_found -> () with Not_found -> ()
end end
...@@ -298,13 +297,15 @@ let flat_extraction mm = function ...@@ -298,13 +297,15 @@ let flat_extraction mm = function
| Module (path, ms) -> | Module (path, ms) ->
let m = find_module_path mm path ms in (* FIXME: catch Not_found here *) let m = find_module_path mm path ms in (* FIXME: catch Not_found here *)
let m_t = translate_module m in let m_t = translate_module m in
Ident.Mid.iter (fun id _ -> visit mm id) m_t.Mltree.mod_known; let recurs = opt_rec_single = Recursive in
Ident.Mid.iter (fun id _ -> visit ~recurs mm id) m_t.Mltree.mod_known;
Mstr.add ms m mm Mstr.add ms m mm
| Symbol (path, ms, s) -> | Symbol (path, ms, s) ->
let m = find_module_path mm path ms in let m = find_module_path mm path ms in
let ns = m.mod_export in let ns = m.mod_export in
let id = find_symbol_id ns s in let id = find_symbol_id ns s in
visit mm id; let recurs = opt_rec_single = Recursive in
visit ~recurs mm id;
Mstr.add ms m mm Mstr.add ms m mm
let () = let () =
...@@ -315,7 +316,8 @@ let () = ...@@ -315,7 +316,8 @@ let () =
| Flat -> | Flat ->
let mm = Queue.fold flat_extraction Mstr.empty opt_queue in let mm = Queue.fold flat_extraction Mstr.empty opt_queue in
let visit_m _ m = let tm = translate_module m in let visit_m _ m = let tm = translate_module m in
Ident.Mid.iter (fun id _ -> visit mm id) tm.Mltree.mod_known in let visit_id id _ = visit ~recurs:true mm id in
Ident.Mid.iter visit_id tm.Mltree.mod_known in
Mstr.iter visit_m mm; Mstr.iter visit_m mm;
let (_fg, pargs, pr) = Pdriver.lookup_printer opt_driver in let (_fg, pargs, pr) = Pdriver.lookup_printer opt_driver in
let cout = match opt_output with let cout = match opt_output with
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment