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