Typing question

[Sylvain <Sylvain.Baro@lip6.fr>]

Hello,

I tried to compile this file "foobar.ml" issuing 

ocamlc -c -i foobar.ml > foobar.mli
ocamlc -c -i foobar.mli
ocamlc -c foobar.ml

But at the third stage of the process, it answers me that the
implementation doesn't match the interface ...

I joined the file "as is" in the following, because it is a short one.

-- begin --
(* Name server *)

open Hashtbl


exception EmptyContextAllocation
exception NameAlreadyUsed of string


class virtual answerToIsNewName =
  object 
  method virtual isNewName : string -> bool
end

type nameType =
    ConstrName
  | TypeName
  | PredName
  | VarName
  | MuName


type nameInfo =
    { kind : nameType ; num : int}


(* one table because each  number identificator is unique *)
let (numTable : (int,string) t) =
  create 111


let global_name_cpt = ref 0
let gen_new_global () = 
  incr global_name_cpt ; !global_name_cpt




(* one nameTable should be created for each scope *)
class nameTable (fatherContext : #answerToIsNewName) =
  object(self)
  val table  =
    (create 17 : (string,nameInfo) t)

  val fatherContext  = ((fatherContext) : #answerToIsNewName)

 method newName kindOf  =
    ((let newnum = gen_new_global ()
    in
    let newname = string_of_int newnum (* Temporaire *)
    in
    let register () = 
      add numTable newnum newname ;
      add table newname {kind = kindOf ; num = newnum}
    in
    try
      find table newname ; 
      self#newName kindOf
    with Not_found ->
      (register () ; newname)) : string)
          


  method isNewName n = 
    try 
      find table n ; false
    with Not_found -> fatherContext#isNewName n


  method addName name kindOf =
    let newnum = gen_new_global ()
    in
    let register () = 
      add numTable newnum name ;
      add table name {kind = kindOf ; num = newnum}
    in
    try
      find table name ; 
      raise (NameAlreadyUsed name)
    with Not_found ->
      register ()
   
  method delName name =
    remove table name

end


class emptyContextClass =
  object
  method newName (x : nameType) = ((raise EmptyContextAllocation) :
string)
  method isNewName (s : string) = true
  method addName (n:string) (k:nameType) = 
    ((raise EmptyContextAllocation) : unit)

end

let emptyContext = new emptyContextClass


-- end --

Thank you.

-- 

					Sylvain Baro
					Sylvain.Baro@lip6.fr