tests/functor_tests.ml

   1 open Defs
   2
   3 let r1 =
   4   begin
   5     let map : r1 -> r1 = Functor_r1.map in
   6     let x = {r1_l1 = 2; r1_l2 = 12} in
   7
   8     assert (map x = x);
   9   end
  10
  11 let intseq =
  12   begin
  13     let map : intseq -> intseq = Functor_intseq.map in
  14     let i = ICons (0, ICons (1, ICons (2, INil))) in
  15       assert (map i = i);
  16   end
  17
  18 let seq =
  19   begin
  20     let map =
  21       let module M : sig val map : ('a -> 'b) -> 'a seq -> 'b seq end
  22         = struct let map = Functor_seq.map end in M.map in
  23       assert (map ((+)1) (Cons (1, Cons (2, Cons (3, Cons (4, Nil)))))
  24               = Cons (2, Cons (3, Cons (4, Cons (5, Nil)))));
  25   end
  26
  27 let poly7 =
  28   begin
  29     let map =
  30       let module M : sig val map : ('a -> 'b) -> 'a poly7 -> 'b poly7 end
  31         = struct let map = Functor_poly7.map end in M.map in
  32       assert (map ((+)1) (Foo (`F 0)) = Foo (`F 1));
  33   end
  34
  35 let poly8 =
  36   begin
  37     let map =
  38       let module M : sig val map : ('a -> 'b) -> 'a poly8 -> 'b poly8 end
  39         = struct let map = Functor_poly8.map end in M.map in
  40       assert (map ((+)1)
  41                 { x = `G (`H (`I (Foo (`F 0))))}
  42               = { x = `G (`H (`I (Foo (`F 1))))});
  43   end
  44
  45 let poly10 =
  46   begin
  47     let map : poly10 -> poly10 = Functor_poly10.map in
  48       assert (map `F = `F);
  49       assert (map (`Cons (1,`Cons (2, `Nil))) = (`Cons (1,`Cons (2, `Nil))));
  50   end
  51
  52 let pmutrec =
  53   begin
  54     let _ =
  55       let module M : sig val map : ('a -> 'b) -> ('c -> 'd) -> ('a,'c) pmutrec_a -> ('b,'d) pmutrec_a end
  56         = struct let map = Functor_pmutrec_a.map end in M.map in
  57     let _ =
  58       let module M : sig val map : ('a -> 'b) -> ('c -> 'd) -> ('a,'c) pmutrec_b -> ('b,'d) pmutrec_b end
  59         = struct let map = Functor_pmutrec_b.map end in M.map in
  60     let _ =
  61       let module M : sig val map : ('a -> 'b) -> ('c -> 'd) -> ('a,'c) pmutrec_c -> ('b,'d) pmutrec_c end
  62         = struct let map = Functor_pmutrec_c.map end in M.map in
  63     let _ =
  64       let module M : sig val map : ('a -> 'b) -> ('c -> 'd) -> ('a,'c) pmutrec_d -> ('b,'d) pmutrec_d end
  65         = struct let map = Functor_pmutrec_d.map end in M.map in
  66       ()
  67   end
  68
  69 let ff1 =
  70   begin
  71     let map =
  72       let module M : sig val map : ('a -> 'b) -> 'a ff1 -> 'b ff1 end
  73         = struct let map = Functor_ff1.map end in M.map in
  74       assert (map ((+)1) (F (1,2)) = F (2,3));
  75       assert (map ((+)1) (G 3) = G 3);
  76   end
  77
  78 let ff2 =
  79   begin
  80     let map f =
  81       let module M : sig val map : ('a -> 'b) -> ('c -> 'd) -> ('a,'c) ff2 -> ('b,'d) ff2 end
  82         = struct let map = Functor_ff2.map end in M.map f in
  83       assert (map ((+)1) not (F1 (F2 (Cons (1,Cons (2, Nil)), 3, Some true)))
  84                 = (F1 (F2 (Cons (2,Cons (3, Nil)), 3, Some false))));
  85
  86       assert (map not ((+)1) (F1 (F2 (Cons (true,Nil), 3, Some 0)))
  87               =  (F1 (F2 (Cons (false,Nil), 3, Some 1))));
  88   end
  89
  90 (*
  91 type 'a constrained = [`F of 'a] constraint 'a = int
  92 *)
  93
  94 let t =
  95   begin
  96     let map : int -> int = Functor_t.map in
  97       assert (map 12 = 12);
  98   end