Re: [Caml-list] Expansion of type-constructors in ctype.ml

["Christoph Höger" <christoph.hoeger@tu-berlin.de>]

[-- Attachment #1: Type: text/plain, Size: 630 bytes --]

find attached a patch against the 4.02.3 tree that solves my issue with
compiling the problematic examples.

I am pretty confident that the change to eqtype is sound, I do not know
exactly what moregen() is intended to do, though and it seems that its
side-effects are required (that is why I expand the types there in any
case).

I appreciate any further comments,

Christoph

-- 
Christoph Höger

Technische Universität Berlin
Fakultät IV - Elektrotechnik und Informatik
Übersetzerbau und Programmiersprachen

Sekr. TEL12-2, Ernst-Reuter-Platz 7, 10587 Berlin

Tel.: +49 (30) 314-24890
E-Mail: christoph.hoeger@tu-berlin.de

[-- Attachment #2: large_classes.patch --]
[-- Type: text/x-patch, Size: 2117 bytes --]

diff --git a/typing/ctype.ml b/typing/ctype.ml
index d1ff9da..2125d00 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -2948,6 +2948,21 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
         link_type t1 t2
     | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
         ()
+    | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
+         when Path.same p1 p2 ->
+       begin try
+           moregen_list inst_nongen type_pairs env tl1 tl2 ;
+           (* expand afterwards, this seems to be an expected side-effect *)
+           ignore (expand_head env t1 ) ;
+           ignore (expand_head env t2 ) ;
+         with e ->
+           let t1' = expand_head env t1 in
+           let t2' = expand_head env t2 in
+           let t1' = repr t1' and t2' = repr t2' in
+           (* prevent non-termination (is this really necessary?) *)
+           if t1' == t1 && t2' == t2 then raise e else
+             moregen inst_nongen type_pairs env t1 t2
+       end
     | _ ->
         let t1' = expand_head env t1 in
         let t2' = expand_head env t2 in
@@ -3213,6 +3228,23 @@ let rec eqtype rename type_pairs subst env t1 t2 =
         end
     | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
         ()
+
+    | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
+         when Path.same p1 p2 ->
+       (* Optimize equality of large type-constructors.
+          Equality of all arguments implies equality of the result, expand 
+          only in case of non-equality (since equivalence does not hold) *)          
+       begin try
+         eqtype_list rename type_pairs subst env tl1 tl2
+       with e -> 
+           let t1' = expand_head_rigid env t1 in
+           let t2' = expand_head_rigid env t2 in
+           let t1' = repr t1' and t2' = repr t2' in
+           (* prevent non-termination (is this really necessary?) *)
+           if t1' == t1 && t2' == t2 then raise e else
+             eqtype rename type_pairs subst env t1' t2'
+       end
+
     | _ ->
         let t1' = expand_head_rigid env t1 in
         let t2' = expand_head_rigid env t2 in