summaryrefslogtreecommitdiffstats
path: root/testlabl
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2006-10-10 04:54:42 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2006-10-10 04:54:42 +0000
commit37473291bf420df157f0c23c15ddfc9a149d36ab (patch)
treea717745a7fa4ee44d16b6cd75b75ff2e0c5d4118 /testlabl
parent9b58a4e5420824f3599978bb976f93d9d919a83a (diff)
applications in paths
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7686 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'testlabl')
-rw-r--r--testlabl/varunion.ml87
1 files changed, 85 insertions, 2 deletions
diff --git a/testlabl/varunion.ml b/testlabl/varunion.ml
index bee7ec7b6..fa6ef11f8 100644
--- a/testlabl/varunion.ml
+++ b/testlabl/varunion.ml
@@ -157,10 +157,17 @@ module M = F(String)
let f = function #M.t -> 1 | #M.u -> 2
let f = function #M.t -> 1 | _ -> 2
type t = [M.t | M.u]
-let f = function #t -> 1 | _ -> 2
+let f = function #t -> 1 | _ -> 2;;
+module G(X : sig type t = private [> ] type u = private [> ] ~ [t] end) =
+ struct let f = function #X.t -> 1 | _ -> 2 end;;
+module M1 = G(struct module N = F(String) type t = N.t type u = N.u end) ;;
+module M1 = G(struct type t = M.t type u = M.u end) ;;
(* bad *)
let f = function #F(String).t -> 1 | _ -> 2;;
-
+type t = [F(String).t | M.u]
+let f = function #t -> 1 | _ -> 2;;
+module N : sig type t = private [> ] end =
+ struct type t = [F(String).t | M.u] end;;
(* Expression Problem: functorial form *)
@@ -333,3 +340,79 @@ module LEnd = struct
let eval `Dummy = `Dummy
end
module rec L : Exp with type t = [num | L.t add | `Dummy] = LAdd(L)(LEnd)
+
+(* Back to first form, but add map *)
+
+module Num(X : Exp) = struct
+ type t = num
+ let map f x = x
+ let eval1 (`Num _ as x) : X.t = x
+ let show (`Num n) = string_of_int n
+end
+
+module Add(X : Exp with type t = private [> num | 'a add] as 'a) = struct
+ type t = X.t add
+ let show (`Add(e1, e2) : t) = "("^ X.show e1 ^"+"^ X.show e2 ^")"
+ let map f (`Add(e1, e2) : t) = `Add(f e1, f e2)
+ let eval1 (`Add(e1, e2) as e : t) =
+ match e1, e2 with
+ `Num n1, `Num n2 -> `Num (n1+n2)
+ | `Num 0, e | e, `Num 0 -> e
+ | _ -> e
+end
+
+module Mul(X : Exp with type t = private [> num | 'a mul] as 'a) = struct
+ type t = X.t mul
+ let show (`Mul(e1, e2) : t) = "("^ X.show e1 ^"*"^ X.show e2 ^")"
+ let map f (`Mul(e1, e2) : t) = `Mul(f e1, f e2)
+ let eval1 (`Mul(e1, e2) as e : t) =
+ match e1, e2 with
+ `Num n1, `Num n2 -> `Num (n1*n2)
+ | `Num 0, e | e, `Num 0 -> `Num 0
+ | `Num 1, e | e, `Num 1 -> e
+ | _ -> e
+end
+
+module Ext(X : sig type t = private [> ] end)(Y : sig type t end) = struct
+ module type S =
+ sig
+ type t = private [> ] ~ [ X.t ]
+ val map : (Y.t -> Y.t) -> t -> t
+ val eval1 : t -> Y.t
+ val show : t -> string
+ end
+end
+
+module Mix(E : Exp)(E1 : Ext(E)(E).S)(E2 : Ext(E1)(E).S) =
+ struct
+ type t = [E1.t | E2.t]
+ let map f = function
+ #E1.t as x -> (E1.map f x : E1.t :> t)
+ | #E2.t as x -> (E2.map f x : E2.t :> t)
+ let eval1 = function
+ #E1.t as x -> E1.eval1 x
+ | #E2.t as x -> E2.eval1 x
+ let show = function
+ #E1.t as x -> E1.show x
+ | #E2.t as x -> E2.show x
+ end
+
+module type ET = sig
+ type t
+ val map : (t -> t) -> t -> t
+ val eval1 : t -> t
+ val show : t -> string
+end
+
+module Fin(E : ET) = struct
+ include E
+ let rec eval e = eval1 (map eval e)
+end
+
+module rec EAdd : (Exp with type t = [num | EAdd.t add]) =
+ Fin(Mix(EAdd)(Num(EAdd))(Add(EAdd)))
+
+module rec E : Exp with type t = [num | E.t add | E.t mul] =
+ Fin(Mix(E)(Mix(E)(Num(E))(Add(E)))(Mul(E)))
+
+let e = E.eval (`Add(`Mul(`Num 2,`Num 3),`Num 1))