diff options
Diffstat (limited to 'src/specialize.ml')
| -rw-r--r-- | src/specialize.ml | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/src/specialize.ml b/src/specialize.ml index 191ee3be..465c5398 100644 --- a/src/specialize.ml +++ b/src/specialize.ml @@ -335,12 +335,13 @@ let specialize_id_fundef instantiations id ast = let spec_id = id_of_instantiation id instantiation in if IdSet.mem spec_id !spec_ids then [] else begin + prerr_endline ("specialised fundef " ^ string_of_id id ^ " to " ^ string_of_id spec_id); spec_ids := IdSet.add spec_id !spec_ids; [DEF_fundef (rename_fundef spec_id fundef)] end in let fundefs = List.map specialize_fundef instantiations |> List.concat in - append_ast pre_ast (append_ast (Defs fundefs) post_ast) + append_ast pre_ast (append_ast (Defs (DEF_fundef fundef :: fundefs)) post_ast) | Some _ -> assert false (* unreachable *) let specialize_id_overloads instantiations id (Defs defs) = @@ -380,8 +381,11 @@ let remove_unused_valspecs env ast = let rec remove_unused (Defs defs) id = match defs with - | def :: defs when is_fundef id def -> remove_unused (Defs defs) id + | def :: defs when is_fundef id def -> + prerr_endline ("Removing fundef: " ^ string_of_id id); + remove_unused (Defs defs) id | def :: defs when is_valspec id def -> + prerr_endline ("Removing valspec: " ^ string_of_id id); remove_unused (Defs defs) id | DEF_overload (overload_id, overloads) :: defs -> begin @@ -396,7 +400,9 @@ let remove_unused_valspecs env ast = List.fold_left (fun ast id -> Defs (remove_unused ast id)) ast (IdSet.elements unused) let specialize_id id ast = + prerr_endline ("specialising: " ^ string_of_id id); let instantiations = instantiations_of id ast in + List.iter (fun i -> prerr_endline (string_of_instantiation i)) instantiations; let ast = specialize_id_valspec instantiations id ast in let ast = specialize_id_fundef instantiations id ast in @@ -424,7 +430,9 @@ let specialize_ids ids ast = let ast = List.fold_left (fun ast id -> specialize_id id ast) ast (IdSet.elements ids) in let ast = reorder_typedefs ast in let ast, _ = Type_check.check Type_check.initial_env ast in - let ast = List.fold_left (fun ast id -> rewrite_polymorphic_calls id ast) ast (IdSet.elements ids) in + let ast = + List.fold_left (fun ast id -> rewrite_polymorphic_calls id ast) ast (IdSet.elements ids) + in let ast, env = Type_check.check Type_check.initial_env ast in let ast = remove_unused_valspecs env ast in ast, env @@ -522,6 +530,7 @@ let specialize_variants ((Defs defs) as ast) env = Type_check.check Type_check.initial_env ast let rec specialize ast env = + prerr_endline (Util.log_line __MODULE__ __LINE__ "Performing specialisation pass"); let ids = polymorphic_functions (fun kopt -> is_typ_kopt kopt || is_order_kopt kopt) ast in if IdSet.is_empty ids then specialize_variants ast env |