lib/mlton/set/type.fun

   1 (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7 (*-------------------------------------------------------------------*)
   8 (*                               Type                                *)
   9 (*-------------------------------------------------------------------*)
  10
  11 functor Type (): TYPE =
  12 struct
  13
  14 datatype set =
  15     EmptySet
  16   | Set of elt
  17 and elt =
  18     Base
  19   | Pair of elt * elt
  20   | EltSet of set
  21
  22 exception Incompatible
  23
  24 fun combineSet(EmptySet, EmptySet) = EmptySet
  25   | combineSet(EmptySet, Set t) = Set t
  26   | combineSet(Set t, EmptySet) = Set t
  27   | combineSet(Set t, Set t') = Set(combineElt(t, t'))
  28 and combineElt(Base, Base) = Base
  29   | combineElt(Pair(t, t1), Pair(t', t1')) =
  30     Pair(combineElt(t, t'), combineElt(t1, t1'))
  31   | combineElt(EltSet t, EltSet t') = EltSet(combineSet(t, t'))
  32   | combineElt _ = raise Incompatible
  33
  34 fun combineToCompat combine a =
  35     (combine a ; true) handle Incompatible => false
  36
  37 structure Set =
  38     struct
  39         type t = set
  40         val combine = combineSet
  41         val areCompatible = combineToCompat combine
  42     end
  43
  44 structure Elt =
  45     struct
  46         type t = elt
  47         val combine = combineElt
  48         val areCompatible = combineToCompat combine
  49     end
  50
  51 fun combineSetElt(EmptySet, t) = Set t
  52   | combineSetElt(Set t, t') = Set(Elt.combine(t, t'))
  53
  54 val areCompatibleSetElt = combineToCompat combineSetElt
  55
  56 end
  57
  58 structure Type = Type()