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