Problem of coercion in recursive class definitions

From: Peter Schrammel (peter.schrammel@unibw-muenchen.de)
Date: Fri Oct 08 1999 - 02:17:54 MET DST

Date: Fri, 08 Oct 1999 02:17:54 +0200
From: Peter Schrammel <peter.schrammel@unibw-muenchen.de>
Subject: Problem of coercion in recursive class definitions

This is a multi-part message in MIME format.
--------------6FACB4885BE1B1301FFE7095
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Sorry if this might be a RTFM problem but I tried to solve it for the
last week but didn't make it.
I attached two modules I wrote, The xmlParser.ml module is an
instantiation of the xmlState.ml*. But it gives me the error:

The method set_xml_cache has type cache:my_cache -> my_state0
but is expected to have type
  cache:(my_content_handler #XmlState.xml_state as 'b,
my_content_handler)
        XmlState.xml_cache ->
  (< debug : unit -> unit;
     get_ch_factory :
       (my_content_handler Grove.small_obj_factory, Unicode.ustring)
       Grove.factory;
     get_xml_cache : ('b, my_content_handler) XmlState.xml_cache;
     get_xml_zipper : ('b, my_content_handler) XmlState.xml_zipper;
     set_ch_factory :
       factory:(my_content_handler Grove.small_obj_factory,
Unicode.ustring)
               Grove.factory ->
       'b;
     set_xml_cache : 'a;
     set_xml_zipper :
       zipper:('b, my_content_handler) XmlState.xml_zipper -> 'c;
     .. > as 'c) as 'a
Type my_state0 = < .. > is not compatible with type 'c
Self type cannot escape its class

Although I tried the coercion trick from page 40 of the manual.
Thanks for any help,
Peter 

--
Peter Schrammel
UniBw-Muenchen 106/2/116
85579 Neubiberg
ICQ: 5469131
--------------6FACB4885BE1B1301FFE7095
Content-Type: text/plain; charset=us-ascii;
 name="xmlState.mli"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="xmlState.mli"

open Unicode;;
type 'a content = START of 'a | TAG of 'a * 'a | EMPTY of 'a | PCDATA of 'a
type cachetype = PERef of Unicode.ustring | ERef of  Unicode.ustring 

type context = Unicode.ustring Grove.big_pattern
type rOD_content = XmlTypes.refOrData content

(*state and contenthandler are parameter*)

class virtual ['state] content_handler :
  object
    constraint 'state = 'chandler #xml_state
      (*parse: get's some relevant information out of the content.
         for example the name of the element or the name of an id*)
    method virtual parse : state:'state -> 'state
      (*cache: bring this information into the cache *)
    method virtual cache : state:'state -> 'state
      (*uncache: remove it from there*)
    method virtual uncache : state:'state -> 'state
    method virtual deref : state:'state -> dtd:bool -> peref:bool ->
      eref:bool -> chref:bool -> XmlTypes.refOrData list * 'state
  end

and virtual ['chandler] xml_state :
  object ('self)
    constraint 'chandler = 'state #content_handler
    method virtual get_xml_zipper : ('state,'chandler) xml_zipper
    method virtual set_xml_zipper : zipper:('state,'chandler) xml_zipper -> 'self

    method virtual get_xml_cache  : ('state,'chandler) xml_cache
    method virtual set_xml_cache  : cache:('state,'chandler) xml_cache -> 'self

    method virtual get_ch_factory : ('chandler Grove.small_obj_factory,ustring) Grove.factory
    method virtual set_ch_factory : factory:('chandler Grove.small_obj_factory,ustring) Grove.factory
      -> 'state

end

and virtual ['state,'chandler] 
      xml_node : content:rOD_content -> chandler:'chandler ->
object
  constraint 'state = 'chandler #xml_state
  constraint 'chandler = 'state #content_handler

  inherit Zipper.zip_obj
  inherit ['state] content_handler

  method virtual get_content : rOD_content
  method virtual set_content : content:rOD_content -> unit
  method virtual set_chandler : chandler:'chandler -> unit
end

and  virtual ['state,'chandler] xml_zipper : root:('state,'chandler) xml_node ->
  object
    constraint 'state = 'chandler #xml_state
    constraint 'chandler = 'state #content_handler

    inherit [('state,'chandler) xml_node] Zipper.zipper
    method virtual build : preparsed:PreParser.tagOrPCData list ->
        state:'state -> 'state

end

and virtual ['state,'chandler] xml_cache :
object ('cache)
  constraint 'state = 'chandler #xml_state
  constraint 'chandler = 'state #content_handler

  method virtual set : key:cachetype -> data:('state,'chandler) xml_node -> 'cache
  method virtual get : key:cachetype -> ('state,'chandler) xml_node
  method virtual remove : key:cachetype -> 'cache
end

--------------6FACB4885BE1B1301FFE7095
Content-Type: text/plain; charset=us-ascii;
 name="xmlParser.ml"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="xmlParser.ml"

open Unicode;;
let us = Unicode.ustring_of_string;;
let uc = Unicode.uchar_of_char;;
let su = string_of_ustring;;
open XmlState;;

exception Parser_Error;;
exception Cache_Error;;

(*
let debug_cachetype = function
    PERef u -> print_string (su u)
  | ERef u -> print_string (su u)
*)

class virtual my_state0 option:(opt : Eoption.eoption) xzipper:(z : my_zipper) 
    ch_factory:(cf : (my_content_handler Grove.small_obj_factory,ustring) Grove.factory) = 
(*I have to declare this class to be able to coerce my_state*)
  object
    inherit [my_content_handler] xml_state
    inherit Debug.debug

    method virtual get_xml_cache  : my_cache
    method virtual set_xml_cache  : cache:my_cache -> my_state0

    method virtual get_xml_zipper : my_zipper
    method virtual set_xml_zipper : zipper:my_zipper -> my_state0

    method virtual get_ch_factory : (my_content_handler Grove.small_obj_factory,ustring) Grove.factory
    method virtual set_ch_factory : factory:(my_content_handler Grove.small_obj_factory,ustring) 
        Grove.factory -> my_state0

    method virtual get_entity_proxy : Catalog.entity_proxy
    method virtual get_option : Eoption.eoption

end

and my_content_handler =
  object
    inherit [my_state] content_handler
    method parse  state:(s : my_state) = s
    method cache  state:(s : my_state) = s
    method uncache  state:(s : my_state) = s
    method deref  state:(s : my_state) dtd:(dtd : bool) peref:(per : bool) 
         eref:(er : bool) chref:(chr : bool) = (([] : XmlTypes.refOrData list),(s : my_state))
    method debug () = ()
  end

and my_node content:(cnt : rOD_content) chandler:(ch : my_content_handler) = 
  object
    inherit [my_state,my_content_handler] xml_node content:cnt chandler:ch
    val mutable content = cnt
    val mutable chandler = ch
    method get_content = content
    method set_content content:c = content <-cnt
    method set_chandler chandler:ch = chandler<-ch
    method parse = chandler#parse
    method cache = chandler#cache
    method uncache = chandler#uncache
    method deref = chandler#deref
    method debug () = ()
  end

and my_zipper root:(root : my_node) =
  object
    inherit [my_state,my_content_handler] xml_zipper root:root
    method build preparsed:(pre : PreParser.tagOrPCData list) state:(state : my_state) =
      state
end

and  my_cache = 
  object (self)
    inherit  [my_state,my_content_handler] xml_cache

    val mutable cache = Hashtbl.create size:191

    method set key:(k : cachetype)  data:(d :  my_node) = 
      try let _ = Hashtbl.find cache key:k
          in
          raise Cache_Error
      with Not_found -> Hashtbl.add cache key:k data:d;self

    method remove key:k = Hashtbl.remove cache key:k;self

    method get key:k = Hashtbl.find cache key:k

(*    method debug () = 
      let print k (d :  my_node)= 
        debug_cachetype k;
        print_string " -> ";
        d#debug ();
        print_newline ();
      in
      Hashtbl.iter fun:(fun key:k data:d -> print k d) cache;*)
  end

and my_state option:(opt :Eoption.eoption)  xzipper:(xzipper : my_zipper) 
    ch_factory:( chfac : (my_content_handler Grove.small_obj_factory,ustring) Grove.factory) =
  object(self)
    inherit my_state0

    val mutable xc = new my_cache
    val mutable ep = new Catalog.entity_proxy option:opt

    val mutable xz = xzipper
    val mutable op = opt
    val mutable chf = chfac
        
    method get_xml_zipper = xz
    method set_xml_zipper zipper:z = xz <- z;(self : #my_state0 :> my_state0)
        
    method get_xml_cache = xc
    method set_xml_cache cache:c = xc <- c;(self : #my_state0 :> my_state0)
        
    method get_ch_factory = chfac
    method set_ch_factory factory:c = chf <- c;(self : #my_state0 :> my_state0)
      
    method get_entity_proxy = ep
        
    method get_option = op
        
    method debug () = ()
  end

--------------6FACB4885BE1B1301FFE7095--

This archive was generated by hypermail 2b29 : Sun Jan 02 2000 - 11:58:26 MET