regression/ring.sml

   1 signature RING =
   2    sig
   3       type ring
   4       type elt
   5
   6       val make : {zero : 'a,
   7                   one : 'a,
   8                   + : 'a * 'a -> 'a,
   9                   * : 'a * 'a -> 'a} -> {ring : ring,
  10                                          valOf : elt -> 'a}
  11
  12       val zero : ring -> elt
  13       val one : ring -> elt
  14       val ringOf : elt -> ring
  15
  16       exception TypeError (* raised by * or + with bogus args *)
  17       val * : elt * elt -> elt
  18       val + : elt * elt -> elt
  19    end
  20
  21 structure Ring : RING =
  22    struct
  23       datatype ring =
  24          Ring of unit -> {zero : elt,
  25                           one : elt,
  26                           + : elt * elt -> elt,
  27                           * : elt * elt -> elt}
  28       and elt = Elt of unit -> {ring : ring}
  29
  30       fun ringOf(Elt th) = #ring(th())
  31
  32       fun extract sel (Ring th) = sel(th())
  33
  34       val zero = extract #zero
  35       val one = extract #one
  36
  37       local
  38          fun make sel (x,y) = extract sel (ringOf x) (x,y)
  39       in
  40          val op * = make(# * )
  41          val op + = make(# +)
  42       end
  43
  44       exception TypeError
  45
  46       fun 'a make{zero, one, +, * = op *} =
  47          let
  48             val r : 'a option ref = ref NONE
  49
  50             fun valOf(Elt th) =
  51                (th() ;
  52                 case !r of
  53                    NONE => raise TypeError
  54                  | SOME x => (x before r := NONE))
  55
  56             fun ring() = {zero = elt zero,
  57                           one = elt one,
  58                           + = binary(op +),
  59                           * = binary(op * )}
  60             and elt(x : 'a) =
  61                Elt(fn () => (r := SOME x ;
  62                              {ring = Ring ring}))
  63             and binary (f : 'a * 'a -> 'a) (x : elt, y : elt) =
  64                elt(f(valOf x, valOf y))
  65
  66          in
  67             {ring = Ring ring,
  68              valOf = valOf}
  69          end
  70    end
  71
  72 val {ring = ints, valOf} = Ring.make{zero = 0,
  73                                      one = 1,
  74                                      + = op +,
  75                                      * = op *}
  76
  77 val _ = (print(Int.toString(valOf(Ring.+(Ring.one ints,
  78                                          Ring.one ints)))) ;
  79          print "\n")