Commits

camlspotter  committed 8da10a2

phantom geti fix

  • Participants
  • Parent commits 5f113d9

Comments (0)

Files changed (3)

File gen_phantom.ml

 
 (*
       unit
-      'a1 * unit
-      'a1 * ('a2 * unit)
-      'a1 * ('a2 * ('a3 * unit))
+      'a0 * unit
+      'a0 * ('a1 * unit)
+      'a0 * ('a1 * ('a2 * unit))
 *)
 let tpl_exp last ppf n = 
   let rec tpl x ppf = function
     | 0 -> fprintf ppf last
-    | n -> fprintf ppf "('a%d * %a)" x (tpl (x+1)) (n-1) 
+    | n -> fprintf ppf "('a%d * %a)" (x - 1) (tpl (x+1)) (n-1) 
   in
   tpl 1 ppf n
 
 let tpl ppf = function
   | 0 -> fprintf ppf "tpl0"
-  | 1 -> fprintf ppf "'a1 tpl1"
+  | 1 -> fprintf ppf "'a0 tpl1"
   | n -> 
       fprintf ppf "(%a) tpl%d"
         (list (fun ppf -> fprintf ppf ",")
-           (fun ppf i -> fprintf ppf "'a%d" i)) (from_to 1 n)
+           (fun ppf i -> fprintf ppf "'a%d" i)) (from_to 0 (n-1))
         n
 
 let tpl_def ppf = function
   fprintf ppf "val c%d : %a(%a,'cont) ts@."
     n
     (list (fun _ppf -> ())
-       (fun ppf i -> fprintf ppf "('a%d,'cont) t -> " i)) (from_to 1 n)
+       (fun ppf i -> fprintf ppf "('a%d,'cont) t -> " i)) (from_to 0 (n-1))
     tpl n
  
 let sig_d ppf n =
     n
     tpl n
     (list (fun ppf -> fprintf ppf " * ")
-       (fun ppf i -> fprintf ppf "('a%d, 'cont) t" i)) (from_to 1 n)
+       (fun ppf i -> fprintf ppf "('a%d, 'cont) t" i)) (from_to 0 (n-1))
  
 let sig_get ppf n =
   fprintf ppf "val get%d : (%a, 'cont) ts -> ('a%d, 'cont) t@."
-    n
+    (n - 1)
     (tpl_exp "_") n
-    n
+    (n - 1)
  
 let max = 10
 

File phantom_head.ml

 type ('phantom, 'content) t = 'content
-type ('phantom, 'content) ts = 'content list
 
 module Open = struct
   type unknown
 end
 include Open
 let unsafe x = x
-let unsafe_list x = x
 let magic x = x
 
-let to_list v = v
-let to_unknown_list v = v
-let to_array = Array.of_list
-let to_unknown_array = Array.of_list
-let of_unknown_list v = v
-let of_unknown_array = Array.to_list
-let unsafe_of_list v = v
-let unsafe_of_array = Array.to_list
+let map f x = f x
+let combine x y = (x,y)
 
-let length = List.length 
+type ('phantom, 'content) ts = 'content list
 
 let c0 = []
 let c1 t = [t]
 let d9 = function [t1; t2; t3; t4; t5; t6; t7; t8; t9] -> (t1, t2, t3, t4, t5, t6, t7, t8, t9) | _ -> assert false
 let d10 = function [t1; t2; t3; t4; t5; t6; t7; t8; t9; t10] -> (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10) | _ -> assert false
 
+let get0 l = List.nth l 0
 let get1 l = List.nth l 1
 let get2 l = List.nth l 2
 let get3 l = List.nth l 3
 let get7 l = List.nth l 7
 let get8 l = List.nth l 8
 let get9 l = List.nth l 9
-let get10 l = List.nth l 10
 
+module List = struct
+  let unsafe_list x = x
+  let to_list v = v
+  let to_unknown_list v = v
+  let to_array = Array.of_list
+  let to_unknown_array = Array.of_list
+  let of_unknown_list v = v
+  let of_unknown_array = Array.to_list
+  let unsafe_of_list v = v
+  let unsafe_of_array = Array.to_list
+  
+  let length = List.length 
+  let map = List.map
+  let combine = List.combine
+
+  type ('phantom, 'content) t = ('phantom, 'content) ts
+end
+

File phantom_head.mli

+(**
+   Opening this module like Spotlib.Spot.Phantom is NOT recommended. 
+   Instead, open Spotlib.Spot.Phantom.Open. Using a module alias is also helpful:
+   
+   module P = Spotlib.Spot.Phantom
+   open P.Open
+*)
 type ('phantom, 'cont) t
 
 (* Rather than open Phantom, I recommend to open Phantom.Open *)
 val magic : ('a, 'cont) t -> ('unsafe, 'cont) t
 (** [magic v] changes the phantom ov [v]. Use with care. *)
 
+val map : ('cont -> 'cont2) -> ('a, 'cont) t -> ('a, 'cont2) t
+val combine : 'tag -> ('a, 'cont) t -> ('a, 'tag * 'cont) t
+
 type ('phantom, 'cont) ts
-  (* phantom heterogeneous 'cont list *)
+(** phantom heterogeneous 'cont list *)
 
-val unsafe_list : 'cont list -> ('unsafe, 'cont) ts
-(** [unsafe_list ls] lifts up [ls] of [elt list] to a list with any phantom. Use with care. *)
-val to_list : ('a, 'cont) ts -> 'cont list
-val to_unknown_list : ('a, 'cont) ts -> (unknown, 'cont) t list
-val to_array : ('a, 'cont) ts -> 'cont array
-val to_unknown_array : ('a, 'cont) ts -> (unknown, 'cont) t array
-val of_unknown_list : (unknown, 'cont) t list -> (unknown, 'cont) ts
-val of_unknown_array : (unknown, 'cont) t array -> (unknown, 'cont) ts
-val unsafe_of_list : 'cont list -> ('unsafe, 'cont) ts
-val unsafe_of_array : 'cont array -> ('unsafe, 'cont) ts
-val length : ('a, 'cont) ts -> int
+module List : sig
+  val unsafe_list : 'cont list -> ('unsafe, 'cont) ts
+  (** [unsafe_list ls] lifts up [ls] of [elt list] to a list with any phantom. Use with care. *)
+  val to_list : ('a, 'cont) ts -> 'cont list
+  val to_unknown_list : ('a, 'cont) ts -> (unknown, 'cont) t list
+  val to_array : ('a, 'cont) ts -> 'cont array
+  val to_unknown_array : ('a, 'cont) ts -> (unknown, 'cont) t array
+  val of_unknown_list : (unknown, 'cont) t list -> (unknown, 'cont) ts
+  val of_unknown_array : (unknown, 'cont) t array -> (unknown, 'cont) ts
+  val unsafe_of_list : 'cont list -> ('unsafe, 'cont) ts
+  val unsafe_of_array : 'cont array -> ('unsafe, 'cont) ts
+  
+  val length : ('a, 'cont) ts -> int
+  val map : ('cont -> 'cont2) -> ('a, 'cont) ts -> ('a, 'cont2) ts
+  val combine : 'tag list -> ('a, 'cont) ts -> ('a, ('tag * 'cont)) ts
+
+  type ('phantom, 'cont) t = ('phantom, 'cont) ts
+end
 
 (* This encoding is correct only if the parameter cannot be the unit or a tuple *)