From 60897fea38949960d3f0e1370bbf73f157e099ec Mon Sep 17 00:00:00 2001
From: Brian Campbell
Date: Fri, 8 Feb 2019 18:06:23 +0000
Subject: Prevent top_sort throwing away overloads (and other multiple
 definitions) Previously it would quietly throw away all definitions for an id
 except one. This usually doesn't matter, but some rewrites use overloaded
 identifiers and can break if the definition is lost.

---
 src/spec_analysis.ml | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/src/spec_analysis.ml b/src/spec_analysis.ml
index 907a2f10..a8ddaf68 100644
--- a/src/spec_analysis.ml
+++ b/src/spec_analysis.ml
@@ -582,6 +582,13 @@ let scc ?(original_order : string list option) (g : graph) =
   List.iter (fun v -> if not (Hashtbl.mem node_indices v) then visit_node v) nodes;
   List.rev !components
 
+let add_def_to_map id d defset =
+  Namemap.add id
+    (match Namemap.find id defset with
+     | t -> d::t
+     | exception Not_found -> [d])
+    defset
+
 let add_def_to_graph (prelude, original_order, defset, graph) d =
   let bound, used = fv_of_def false true [] d in
   let used = match d with
@@ -604,7 +611,7 @@ let add_def_to_graph (prelude, original_order, defset, graph) d =
     let add_other_node id' g = Namemap.add id' (Nameset.singleton id) g in
     prelude,
     original_order @ [id],
-    Namemap.add id d defset,
+    add_def_to_map id d defset,
     Nameset.fold add_other_node other_ids graph_id
   with
   | Not_found ->
@@ -633,11 +640,11 @@ let print_dot graph component : unit =
   | [] -> ()
 
 let def_of_component graph defset comp =
-  let get_def id = if Namemap.mem id defset then [Namemap.find id defset] else [] in
+  let get_def id = if Namemap.mem id defset then Namemap.find id defset else [] in
   match List.concat (List.map get_def comp) with
   | [] -> []
   | [def] -> [def]
-  | (def :: _) as defs ->
+  | (((DEF_fundef _ | DEF_internal_mutrec _) as def) :: _) as defs ->
      let get_fundefs = function
        | DEF_fundef fundef -> [fundef]
        | DEF_internal_mutrec fundefs -> fundefs
@@ -647,6 +654,8 @@ let def_of_component graph defset comp =
      let fundefs = List.concat (List.map get_fundefs defs) in
      print_dot graph (List.map (fun fd -> string_of_id (id_of_fundef fd)) fundefs);
      [DEF_internal_mutrec fundefs]
+  (* We could merge other stuff, in particular overloads, but don't need to just now *)
+  | defs -> defs
 
 let top_sort_defs (Defs defs) =
   let prelude, original_order, defset, graph =
-- 
cgit v1.2.3