Hello,

I'm writing a program using the object facilities provided by Objective
Caml.
In this program, I have to write a tree structure, and the class hierarchy
is
used to apply functions (which could be overwritten) to the tree nodes.

The program was quick to compile until soon. But when I added a new method
in
one of the base class of the tree, the compilation time had been multiplied
by 
more than 300 (12s to more than one hour).

The inheritance structure is quite complex, so I dropped a lot of lines to
make
an example that produce the same problem, but is less complex. I removed
virtual
methods and most of methods:

(************** Start of the module ********************)
module OS =
  struct
    type t = string
    let compare (s1 : string) (s2 : string) = Pervasives.compare s1 s2
  end

module OSO= 
  struct
    type t = string option
    let compare (s1 : string option) (s2 : string option) = 
      match (s1, s2) with
	(None, None)      -> 0
      |	(None, Some _)    -> -1
      |	(Some _, None)    -> 1
      |	(Some v1, Some v2) -> Pervasives.compare v1 v2
  end

module MapString = Map.Make OS

module MapStringOption = Map.Make OSO


class virtual  node = 
  object (self)	
    val mutable children : childNode list = []

    method sub_nodes = children
	
    method append_subnode subnode  = 
      children <- children@[subnode]
  end        

and rootNode = 
    object (self)
      inherit node

    end
      
and virtual childNode (parent : node) =
  object (self)
    inherit  node

    method get_parent : node = parent

(***********************************)
(* method that lead to problem when added *)
method collect_environment : 

    ((referenceableRefNode * string) list *  (userTypeRefNode * string) list
* 
     (referenceableNode MapString.t) * (userTypeNode MapString.t))
MapStringOption.t ->

    ((referenceableRefNode * string) list * (userTypeRefNode * string) list
* 
     (referenceableNode MapString.t) * (userTypeNode MapString.t))
MapStringOption.t =

      fun env -> env (* should be List.fold_left (fun env (n : childNode) ->
n#collect_environment env) env children *)
(***********************************)

and virtual typedNode (parent : node) =
  object (self)
    inherit childNode parent
		
  end
    
and virtual typeBuilderNode (parent : node) =
    object(self)
      inherit typedNode parent
      val mutable _content : typedNode option = None

      method set_content : typedNode -> unit = fun content -> _content <-
Some content
	  
    end      

and virtual userTypeNode (parent : node) =
    object(self)
      inherit typeBuilderNode parent
	  
    end

and virtual baseTypeNode (name : string) (parent : node) = 
  object(self)
    inherit typedNode parent    	
	
    val mutable _name : string = name

  end

and userTypeRefNode (name : string) (parent : node) =
  object(self)
    inherit baseTypeNode name parent	
  end


and virtual referenceableNode (parent : node) =
    object 
      inherit typedNode parent	    	  
    end
      
and virtual referenceableRefNode (parent : node) =
    object 
      inherit typedNode parent	  
    end
      

class stringTypeNode (base : string) (parent : node) =
  object(self)
    inherit baseTypeNode base parent	
  end

class integerTypeNode (base : string) (parent : node) =
  object(self)
    inherit baseTypeNode base parent       
  end

class booleanTypeNode (parent : node) =
  object(self)
    inherit baseTypeNode "boolean" parent	
  end

(***************************************
  method that takes a lot of time to type
   after collect_environment add been added into
   childNode class 
 *)
let getTypeForName : node -> string -> typedNode = 
  fun parent_node type_name ->
    match type_name with
      "string" as _type -> (new stringTypeNode _type parent_node :>
typedNode)	       	
	
    | "foo" as _type ->
	failwith ("this type is not available yet: " ^ _type)
	 
      (* boolean type *)
    | "boolean" -> (new booleanTypeNode parent_node :> typedNode)
	
      (* integer types *)
    | "integer" as _type -> (new integerTypeNode _type parent_node :>
typedNode)

    | ref -> (new userTypeRefNode ref parent_node :> typedNode)	  

(************** end of the module ******************)

If I compile this module with the method collect_environment, the
compilation lasts
70 sec on my computer. If I drop it, it takes only 0.66s

If I change the type of the function and write it:

method collect_environment : 
  ((node * string) list *  (node * string) list * (node MapString.t) * (node
MapString.t)) MapStringOption.t -> 
  ((node * string) list * (node * string) list * (node MapString.t) * (node
MapString.t)) MapStringOption.t =	  
  fun env -> env (* should be List.fold_left (fun env (n : childNode) ->
n#collect_environment env) env children *)
  end

the compilation of the module lasts 1s.

Do you have any idea on the origin of this problem, and on the way to solve
it ?

Thanks.

--
Michaël Marchegay, Stagiaire France Telecom R&D du 11/02/2002 au 26/07/2002
Sous la responsabilité d'Olivier Dubuisson
DTL/TAL - 22307 Lannion Cedex - France