problems with classes and polymorphic recursion

From: Stephan Houben (stephan@pcrm.win.tue.nl)
Date: Sun May 28 2000 - 13:17:20 MET DST

  • Next message: Markus Mottl: "Re: translation of book (fwd)"

    Hello list,

    I'm trying to write a class for doing a finite mapping of "terms"
    on some value 'a.
    A term is defined as:

        type term = Term of term list | Atom

    The idea is to have a class term_map that maps terms on 'a (as said above)
    which uses another class termlist_map that maps "term list"'s on 'a.

    A term_map can contain a termlist_map; when it is given a Term <somelist>,
    then it asks its termlist_map to get the value for <somelist>.

    Similarly, a termlist_map contains a term_map, in which it looks up the
    head of the list (for a non-empty list). The result of this look-up should
    be another termlist_map, in which the tail of the list is looked up.

    (See for the complete code the end of this message.)

    The problem is that the type inferencing gives me a type that is too
    restrictive: according to ocaml, the expression "new term_map"
    has type:

     ((Objtest.term list, 'a) Objtest.map as 'a) Objtest.term_map

    whereas I would expect (and want it to have) just "'_a Objtest.term_map".

    It appears to me (after reading some older postings on the list) that
    the two classes have a polymorphic recursive relation. I.e.
    "'a term_map" contains a "'a termlist_map", which in turn contains
    a "('a termlist_map) term_map". Which leads the typechecker
    to identify "'a" with "'a termlist_map" (a synonym of which is
    "(term list, 'a) map". Which is not useful for me.

    Does anyone have any ideas for an elegant solution to work around this
    problem?

    Thanks,

    Stephan Houben

    -- begin code

        
        type term = Term of term list | Atom

        let access opt =
          match opt with
              None -> raise Not_found
            | Some s -> s

        class type ['key, 'value] map =
          object
            method find : 'key -> 'value
            method add : 'key -> 'value -> unit
          end

        class ['value] term_map =
          object
            val mutable term : (term list, 'value) map option = None
            val mutable atom : 'value option = None
             
            method find (trm : term) : 'value =
              match trm with
                  Term lst -> (access term)#find lst
                | Atom -> access atom

            method add (trm : term) (value : 'value) : unit =
              match trm with
                  Term lst ->
                    (if term = None then term <- Some (new termlist_map);
                     (access term)#add lst value)
                | Atom -> atom <- Some value
          end

        and ['value] termlist_map =
          object
            val mutable nonempty : (term, (term list, 'value) map) map option = None
            val mutable empty : 'value option = None

            method find (lst : term list) : 'value =
              match lst with
                  x :: xs -> ((access nonempty)#find x)#find xs
                | [] -> (access empty)

            method add (lst : term list) (value : 'value) : unit =
              match lst with
                  x :: xs ->
                    (if nonempty = None then nonempty <- Some (new term_map);
                     let tailmap =
                       (try
                          (access nonempty)#find x
                        with Not_found ->
                          let tailmap = new termlist_map
                          in
                            (access nonempty)#add x tailmap; tailmap)
                     in tailmap#add xs value)
                | [] -> empty <- Some value
          end

    -- end code



    This archive was generated by hypermail 2b29 : Thu May 04 2000 - 18:41:30 MET DST