var.ml 2.09 KB
Newer Older
1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
type t = { 
  mutable variance : [ `Covariant | `ContraVariant | `Both | `None ] ;
  fresh : bool;
  id : String.t;
}
let make_id ?(fresh=false) ?(variance=`None) id = 
   { id = id ; variance = variance; fresh = fresh }

let dump ppf t =
  let to_string = function
    |`ContraVariant -> "contravariant"
    |`Covariant -> "covariant"
    |`Both -> "invariant"
    |`None -> "indetermined"
  in
  Format.fprintf ppf "{id=%s;variance=%s;fresh=%b}" t.id (to_string t.variance) t.fresh

let compare x y = Pervasives.compare x.id y.id
let equal x y = Pervasives.compare x.id y.id = 0
let hash x = Hashtbl.hash x.id

23
24
25
type var = [ `Var of t ]
type 'a pairvar = [ `Atm of 'a | var ]

26
27
28
29
30
31
32
33
34
35
36
37
38
39
let dump ppf (`Var x) = Format.fprintf ppf "%a" dump x
let print ppf (`Var x) = Format.fprintf ppf "`$%s" x.id
let compare (`Var x) (`Var y) = compare x y
let equal v1 v2 = (compare v1 v2) = 0

let ch_variance variance (`Var t) =
  match t.variance,variance with
  |`None,_ -> `Var { t with variance = variance }
  |`Both ,_ -> `Var t
  |`ContraVariant,`ContraVariant 
  |`Covariant,`Covariant -> `Var t
  |_,_ -> `Var { t with variance = `Both }

let variance (`Var t) = t.variance
Pietro Abate's avatar
Pietro Abate committed
40
let is_fresh (`Var t) = t.fresh
41
42
43
44
45
46

module Set = Set.Make(
  struct 
    type t = var
    let compare = compare
  end)
47

48
49
module Make (X : Custom.T) = struct
  type t = X.t pairvar
50
  let hash = function `Atm t -> X.hash t | `Var x -> hash x
51
52
53
  let check = function `Atm t -> X.check t | `Var _ -> ()
  let compare t1 t2 =
    match t1,t2 with
54
    |`Var x, `Var y -> compare (`Var x) (`Var y)
55
56
57
58
59
    |`Atm x, `Atm y -> X.compare x y
    |`Var _, `Atm _ -> -1
    |`Atm _, `Var _ -> 1

  let equal t1 t2 = (compare t1 t2) = 0
60

61
62
  let dump ppf = function
    |`Atm x -> X.dump ppf x
Pietro Abate's avatar
Pietro Abate committed
63
    |`Var x -> dump ppf (`Var x)
64
65
end

66
67
68
let mk ?fresh ?variance id = 
  `Var (make_id ?fresh ?variance id)

Pietro Abate's avatar
Pietro Abate committed
69
let fresh : ?pre: string -> ?variance:[ `None| `Both | `ContraVariant | `Covariant ] -> unit -> [> var ] =
70
  let counter = ref 0 in
Pietro Abate's avatar
Pietro Abate committed
71
72
  fun ?(pre="_fresh_") -> fun ?variance -> fun _ ->
    let id = (Printf.sprintf "%s%d" pre !counter) in
73
    let v = mk ~fresh:true ?variance id in
74
75
    incr counter;
    v
76