diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index 3868d6f0f4e..5160429ef50 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -817,14 +817,13 @@ let rebuild_ty_under_params end params in - let substituted = ref false in let rec rebuild_ty t = let base = ty_fold_rebuild (fun t -> t) in let ty_fold_param (i, mut) = let param = Ast.TY_param (i, mut) in match htab_search pmap param with None -> param - | Some arg -> (substituted := true; arg) + | Some arg -> arg in let ty_fold_named n = let rec rebuild_name n = @@ -863,7 +862,7 @@ let rebuild_ty_under_params begin match htab_search nmap id with None -> Ast.TY_named n - | Some arg -> (substituted := true; arg) + | Some arg -> arg end | _ -> Ast.TY_named n in @@ -873,14 +872,7 @@ let rebuild_ty_under_params ty_fold_named = ty_fold_named; } in - let t' = fold_ty fold t in - (* FIXME (issue #77): "substituted" and "ty'" here are only required - * because the current type-equality-comparison code in Type uses <> - * and will judge some cases, such as rebuilt tags, as unequal simply - * due to the different hashtable order in the fold. *) - if !substituted - then t' - else t + fold_ty fold t in rebuild_ty ty ;; diff --git a/src/boot/util/common.ml b/src/boot/util/common.ml index f33a6ea1649..5c381b81206 100644 --- a/src/boot/util/common.ml +++ b/src/boot/util/common.ml @@ -220,6 +220,21 @@ let htab_put (htab:('a,'b) Hashtbl.t) (a:'a) (b:'b) : unit = Hashtbl.add htab a b ;; +(* This is completely ridiculous, but it turns out that ocaml hashtables are + * order-of-element-addition sensitive when it comes to the built-in + * polymorphic comparison operator. So you have to canonicalize them after + * you've stopped adding things to them if you ever want to use them in a + * term that requires structural comparison to work. Sigh. + *) + +let htab_canonicalize (htab:('a,'b) Hashtbl.t) : ('a,'b) Hashtbl.t = + let n = Hashtbl.create (Hashtbl.length htab) in + Array.iter + (fun k -> Hashtbl.add n k (Hashtbl.find htab k)) + (sorted_htab_keys htab); + n +;; + let htab_map (htab:('a,'b) Hashtbl.t) (f:'a -> 'b -> ('c * 'd)) @@ -230,10 +245,9 @@ let htab_map htab_put ntab c d in Hashtbl.iter g htab; - ntab + htab_canonicalize (ntab) ;; - let htab_fold (fn:'a -> 'b -> 'c -> 'c) (init:'c)