bjoernager/rust
bjoernager/rust
1
Fork 0
Code Activity

Canonicalize hashtables after running them through htab_map. Closes #77.

Browse source
This commit is contained in:
Graydon Hoare 2010-06-28 19:24:04 -07:00
parent bd059a354d
commit 329a65530f
2 changed files with 19 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -817,14 +817,13 @@ let rebuild_ty_under_params
end end
params params
in in
let substituted = ref false in
let rec rebuild_ty t = let rec rebuild_ty t =
let base = ty_fold_rebuild (fun t -> t) in let base = ty_fold_rebuild (fun t -> t) in
let ty_fold_param (i, mut) = let ty_fold_param (i, mut) =
let param = Ast.TY_param (i, mut) in let param = Ast.TY_param (i, mut) in
match htab_search pmap param with match htab_search pmap param with
None -> param None -> param
| Some arg -> (substituted := true; arg) | Some arg -> arg
in in
let ty_fold_named n = let ty_fold_named n =
let rec rebuild_name n = let rec rebuild_name n =
@ -863,7 +862,7 @@ let rebuild_ty_under_params
begin begin
match htab_search nmap id with match htab_search nmap id with
None -> Ast.TY_named n None -> Ast.TY_named n
| Some arg -> (substituted := true; arg) | Some arg -> arg
end end
| _ -> Ast.TY_named n | _ -> Ast.TY_named n
in in
@ -873,14 +872,7 @@ let rebuild_ty_under_params
ty_fold_named = ty_fold_named; ty_fold_named = ty_fold_named;
} }
in in
let t' = fold_ty fold t in fold_ty fold t
(* 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
in in
rebuild_ty ty rebuild_ty ty
;; ;;

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

@ -220,6 +220,21 @@ let htab_put (htab:('a,'b) Hashtbl.t) (a:'a) (b:'b) : unit =
Hashtbl.add htab a b 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 let htab_map
(htab:('a,'b) Hashtbl.t) (htab:('a,'b) Hashtbl.t)
(f:'a -> 'b -> ('c * 'd)) (f:'a -> 'b -> ('c * 'd))
@ -230,10 +245,9 @@ let htab_map
htab_put ntab c d htab_put ntab c d
in in
Hashtbl.iter g htab; Hashtbl.iter g htab;
ntab htab_canonicalize (ntab)
;; ;;
let htab_fold let htab_fold
(fn:'a -> 'b -> 'c -> 'c) (fn:'a -> 'b -> 'c -> 'c)
(init:'c) (init:'c)