test_encode_modules.ml 1.91 KB
Newer Older
charguer's avatar
charguer committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109

(************************************************)
(* Functor style *)

module FunctorStyle = struct


  module type ComparableSig = sig
    type t
    val compare : t -> t -> int
  end

  module type HeapSig = sig
    type t
    type elt
    val empty : t
    val add : t -> elt -> t
  end

  module MyHeap (C : ComparableSig) : (HeapSig with type elt = C.t) =
  struct

    type elt = C.t

    type t = elt list

    let empty = []

    let rec add t x = 
      match t with
      | [] -> [x]
      | y::s -> 
         if C.compare x y <= 0 
            then x::t
            else y::(add s x)

  end
 
 (*--- fails!

  module MySort = struct

    let sort (cmp:'a->'a->int) (l:'a list) =
      let module M = MyHeap (struct type t = 'a let compare = cmp end) in
      (* push all then pop all elements from l, simplified to: *)
      M.add l (List.hd l)

  end
  ---*)


end


(* ocamlc test_encode_modules.ml *)


(************************************************)
(* Record style *)

module RecordStyle = struct

  module ComparableSig = struct
  
    type 't contents = {
      compare : 't -> 't -> int }
  
  end

  module HeapSig = struct

    type ('elt,'t) contents = {
      empty : 't;
      add : 't -> 'elt -> 't }

  end

  module MyHeap = struct
    open HeapSig
  
    type 'elt t = 'elt list

    let contents (c:'t ComparableSig.contents) : ('t,'t t) HeapSig.contents  = {
      empty = [];
      add = (let rec add t x = 
                match t with
                | [] -> [x]
                | y::s -> 
                   if c.ComparableSig.compare x y <= 0 
                      then x::t
                      else y::(add s x) 
                in
            add)
    }

  end

  module MySort = struct

    let sort (cmp:'a->'a->int) (l:'a list) =
      let m = MyHeap.contents({ ComparableSig.compare = cmp }) in 
      (* push all then pop all elements from l, simplified to: *) 
      m.HeapSig.add l (List.hd l)

  end


end