1. camlspotter
  2. spotlib

Commits

camlspotter  committed 5f113d9

fixed phantom tul encoding

  • Participants
  • Parent commits be811e5
  • Branches default

Comments (0)

Files changed (18)

File .hgignore

View file
  • Ignore whitespace
 \.omakedb$
 \.depend$
 CVS/.*
+gen_phantom$

File OMakefile

View file
  • Ignore whitespace
    hashSet
    xformat
    phantom
-   phantomz
    spot
 
 LIB = spotlib
    xformat
    gen_phantom
 
-# MyOCamlProgram(gen_phantom, $(PHANTOM_GEN))
+MyOCamlProgram(gen_phantom, $(PHANTOM_GEN))
 
-PHANTOMY_GEN[] =
-   xlist
-   xformat
-   gen_phantomy
+phantom.ml: phantom_head.ml gen_phantom.run
+	./gen_phantom.run ml > $@
 
-MyOCamlProgram(gen_phantomy, $(PHANTOMY_GEN))
+phantom.mli: phantom_head.mli gen_phantom.run
+	./gen_phantom.run mli > $@
 
-phantomy.ml: phantomy_head.ml gen_phantomy.run
-	./gen_phantomy.run ml > $@
-
-phantomy.mli: phantomy_head.mli gen_phantomy.run
-	./gen_phantomy.run mli > $@
-
-PHANTOMZ_GEN[] =
-   xlist
-   xformat
-   gen_phantomz
-
-MyOCamlProgram(gen_phantomz, $(PHANTOMZ_GEN))
-
-phantomz.ml: phantomz_head.ml gen_phantomz.run
-	./gen_phantomz.run ml > $@
-
-phantomz.mli: phantomz_head.mli gen_phantomz.run
-	./gen_phantomz.run mli > $@
-

File gen_phantom.ml

View file
  • Ignore whitespace
 open Format
 open Xformat
+open Xlist
 
-let t ppf = function
-  | 0 -> assert false
-  | n -> fprintf ppf "('a%d, 'content) t" n
+(*
+      unit
+      'a1 * unit
+      'a1 * ('a2 * unit)
+      'a1 * ('a2 * ('a3 * 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) 
+  in
+  tpl 1 ppf n
 
-let ts ppf = function
-  | 0 -> fprintf ppf "'content ts0"
+let tpl ppf = function
+  | 0 -> fprintf ppf "tpl0"
+  | 1 -> fprintf ppf "'a1 tpl1"
   | n -> 
-      fprintf ppf "(%a, 'content) ts%d"
-        (list (fun ppf -> fprintf ppf ", ")
-           (fun ppf i -> fprintf ppf "'a%d" i)) (Xlist.from_to 1 n)
+      fprintf ppf "(%a) tpl%d"
+        (list (fun ppf -> fprintf ppf ",")
+           (fun ppf i -> fprintf ppf "'a%d" i)) (from_to 1 n)
         n
 
-let get_type ppf = function 
-  | 0 -> fprintf ppf "unit"
+let tpl_def ppf = function
+  | 0 -> fprintf ppf "type tpl0 = unit@."
+  | 1 -> fprintf ppf "type %a = %a@." tpl 1 (tpl_exp "unit") 1
   | n -> 
-      fprintf ppf "%a"
-        (list (fun ppf -> fprintf ppf " * ")
-           t) (Xlist.from_to 1 n)
+      fprintf ppf "type %a = %a@."
+        tpl n
+        (tpl_exp "unit") n
 
-let max = 1
-let type_ts ppf n =
-  let kwd = if n = 0 then "type" else "and" in
-  fprintf ppf "%s %a = <@." kwd ts n;
-  fprintf ppf "    list : 'content list;@.";
-  fprintf ppf "    array : 'content array;@.";
-  fprintf ppf "    get : %a;@." get_type n;
-  for i = 1 to n do
-    fprintf ppf "    get%d : %a;@." i t i
-  done;
-  if n < max then 
-    fprintf ppf "    append : 'a%d . %a -> %a;@."
-      (n+1)
-      t (n+1)
-      ts (n+1);
-  fprintf ppf "  >@.@."
-
-let call ppf = function
-  | 0 -> fprintf ppf "ts0 ()"
-  | n -> 
-      fprintf ppf "ts%d %a"
-        n
-        (list (fun ppf -> fprintf ppf " ")
-           (fun ppf i -> fprintf ppf "v%d" i)) (Xlist.from_to 1 n)
-  
-let def_list ppf n =
-  fprintf ppf "[%a]"
-    (list (fun ppf -> fprintf ppf "; ")
-       (fun ppf i -> fprintf ppf "v%d" i)) (Xlist.from_to 1 n)
-  
-let def_array ppf n =
-  fprintf ppf "[|%a|]"
-    (list (fun ppf -> fprintf ppf "; ")
-       (fun ppf i -> fprintf ppf "v%d" i)) (Xlist.from_to 1 n)
-  
-let def_get ppf = function
-  | 0 -> fprintf ppf "()"
-  | 1 -> fprintf ppf "v1"
-  | n ->
-      fprintf ppf "(%a)"
-        (list (fun ppf -> fprintf ppf ", ")
-           (fun ppf i -> fprintf ppf "v%d" i)) (Xlist.from_to 1 n)
-  
-let def_ts ppf n =
-  fprintf ppf "let %a = object@." call n;
-  fprintf ppf "  method list = %a@." def_list n;
-  fprintf ppf "  method array = %a@." def_array n;
-  fprintf ppf "  method get = %a@." def_get n;
-  for i = 1 to n do
-    fprintf ppf "  method get%d = v%d@." i i
-  done;
-  if n < max then 
-    fprintf ppf "  method append v%d = %a@."
-      (n+1) 
-      call (n+1);
-  fprintf ppf "end@.@."
+let sig_ ppf n =
+  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)
+    tpl n
+ 
+let sig_d ppf n =
+  fprintf ppf "val d%d : (%a,'cont) ts -> %a@."
+    n
+    tpl n
+    (list (fun ppf -> fprintf ppf " * ")
+       (fun ppf i -> fprintf ppf "('a%d, 'cont) t" i)) (from_to 1 n)
+ 
+let sig_get ppf n =
+  fprintf ppf "val get%d : (%a, 'cont) ts -> ('a%d, 'cont) t@."
+    n
+    (tpl_exp "_") n
+    n
+ 
+let max = 10
 
 let cat fn =
   let ic = open_in fn in
   Arg.parse [] (function 
     | "ml" ->
         printf "(* This is an autogenerated file. Do not edit. *)@.@.";
-        cat "phantom2_head.ml";
+        cat "phantom_head.ml";
         for i = 0 to max do
-          type_ts std_formatter i
+          tpl_def stdout i
         done;
-        for i = max downto 0 do
-          def_ts std_formatter i
-        done;
-        cat "phantom2_tail.ml"
     | "mli" ->
         printf "(* This is an autogenerated file. Do not edit. *)@.@.";
-        cat "phantom2_head.mli";
+        cat "phantom_head.mli";
         for i = 0 to max do
-          type_ts std_formatter i
+          tpl_def stdout i
         done;
-        cat "phantom2_tail.mli"
+        for i = 0 to max do
+          sig_ stdout i
+        done;
+        for i = 1 to max do
+          sig_d stdout i
+        done;
+        for i = 1 to max do
+          sig_get stdout i
+        done;
     | _ -> failwith "give ml or mli")
     "gen_phantom [ml|mli]"
 

File gen_phantomy.ml

  • Ignore whitespace
-open Format
-open Xformat
-open Xlist
-
-let argtype ppf n = fprintf ppf "('p%d, 'c) t" n
-
-let arguments ppf = function
-  | 0 -> fprintf ppf "()"
-  | n -> 
-      (list (fun ppf -> fprintf ppf " ")
-        (fun ppf i -> fprintf ppf "(t%d : %a)" i argtype i)) ppf
-        (from_to 1 n)
-
-let typ_tsn name ppf = function
-  | 0 -> fprintf ppf "'%s ts0" name
-  | n ->
-      fprintf ppf "(%a, '%s) ts%d"
-        (list (fun ppf -> fprintf ppf ", ")
-           (fun ppf i -> fprintf ppf "'p%d" i)) (from_to 1 n)
-        name
-        n
-
-let typ_get ppf = function
-  | 0 -> fprintf ppf "unit"
-  | n -> (list (fun ppf -> fprintf ppf " * ") argtype) ppf (from_to 1 n)
-
-let typ ppf n =
-  fprintf ppf "type %a = <@." (typ_tsn "c") n;
-  fprintf ppf "  list : 'c list;@.";
-  fprintf ppf "  array : 'c array;@.";
-  fprintf ppf "  get : %a;@." typ_get n;
-  for i = 1 to n do
-    fprintf ppf "  get%d : %a;@." i argtype i
-  done;
-  (* fprintf ppf "  map : 'd. ('c -> 'd) -> %a@." (typ_tsn "d") n; *)
-  fprintf ppf ">@.@."
-
-let def ppf n =
-  fprintf ppf "let c%d %a : %a = object@." n arguments n (typ_tsn "c") n;
-  fprintf ppf "  inherit ['c] ts [%a]@."
-    (list (fun ppf -> fprintf ppf "; ")
-       (fun ppf i -> fprintf ppf "t%d" i))
-    (from_to 1 n);
-  fprintf ppf "  method get = (%a)@."
-    (list (fun ppf -> fprintf ppf ", ")
-       (fun ppf i -> fprintf ppf "t%d" i))
-    (from_to 1 n);
-  for i = 1 to n do
-    fprintf ppf "  method get%d = t%d@." i i
-  done;
-  fprintf ppf "end@.@."
-
-let sig_ ppf n =
-  fprintf ppf "val c%d : %a -> %a@.@." 
-    n
-    (if n = 0 then fun ppf _ -> fprintf ppf "unit"
-     else list (fun ppf -> fprintf ppf " -> ") argtype) (from_to 1 n)
-    (typ_tsn "c") n
-
-(* 
-type ('p1, ... 'pX, 'c) tsX = object
-   list : 'c list
-   array : 'c array
-   get : ...
-   getn : ...
-end
-
-let cX (t1 : ('p1, 'c) t) .. = object
-  inherit unknowns [t1; ... ]
-  method get = (t1, ..., tn)
-  method get1 = t1
-  ...
-end
-*)
- 
-let max = 10
-
-let cat fn =
-  let ic = open_in fn in
-  let rec loop () =
-    let l = input_line ic in
-    printf "%s\n" l;
-    loop ()
-  in
-  try loop () with _ -> close_in ic
-
-let _ =
-  Arg.parse [] (function 
-    | "ml" ->
-        printf "(* This is an autogenerated file. Do not edit. *)@.@.";
-        cat "phantomy_head.ml";
-        for i = 0 to max do
-          typ stdout i;
-          def stdout i
-        done;
-    | "mli" ->
-        printf "(* This is an autogenerated file. Do not edit. *)@.@.";
-        cat "phantomy_head.mli";
-        for i = 0 to max do
-          typ stdout i;
-          sig_ stdout i
-        done;
-    | _ -> failwith "give ml or mli")
-    "gen_phantom [ml|mli]"
-
-
-  

File gen_phantomz.ml

  • Ignore whitespace
-open Format
-open Xformat
-open Xlist
-
-(*
-      unit
-      'a1 * unit
-      'a1 * ('a2 * unit)
-      'a1 * ('a2 * ('a3 * 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) 
-  in
-  tpl 1 ppf n
-
-let tpl ppf = function
-  | 0 -> fprintf ppf "tpl0"
-  | 1 -> fprintf ppf "'a1 tpl1"
-  | n -> 
-      fprintf ppf "(%a) tpl%d"
-        (list (fun ppf -> fprintf ppf ",")
-           (fun ppf i -> fprintf ppf "'a%d" i)) (from_to 1 n)
-        n
-
-let tpl_def ppf = function
-  | 0 -> fprintf ppf "type tpl0 = unit@."
-  | 1 -> fprintf ppf "type %a = %a@." tpl 1 (tpl_exp "unit") 1
-  | n -> 
-      fprintf ppf "type %a = %a@."
-        tpl n
-        (tpl_exp "unit") n
-
-let sig_ ppf n =
-  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)
-    tpl n
- 
-let sig_d ppf n =
-  fprintf ppf "val d%d : (%a,'cont) ts -> %a@."
-    n
-    tpl n
-    (list (fun ppf -> fprintf ppf " * ")
-       (fun ppf i -> fprintf ppf "('a%d, 'cont) t" i)) (from_to 1 n)
- 
-let sig_get ppf n =
-  fprintf ppf "val get%d : (%a, 'cont) ts -> ('a%d, 'cont) t@."
-    n
-    (tpl_exp "_") n
-    n
- 
-let max = 10
-
-let cat fn =
-  let ic = open_in fn in
-  let rec loop () =
-    let l = input_line ic in
-    printf "%s\n" l;
-    loop ()
-  in
-  try loop () with _ -> close_in ic
-
-let _ =
-  Arg.parse [] (function 
-    | "ml" ->
-        printf "(* This is an autogenerated file. Do not edit. *)@.@.";
-        cat "phantomz_head.ml";
-        for i = 0 to max do
-          tpl_def stdout i
-        done;
-    | "mli" ->
-        printf "(* This is an autogenerated file. Do not edit. *)@.@.";
-        cat "phantomz_head.mli";
-        for i = 0 to max do
-          tpl_def stdout i
-        done;
-        for i = 0 to max do
-          sig_ stdout i
-        done;
-        for i = 1 to max do
-          sig_d stdout i
-        done;
-        for i = 1 to max do
-          sig_get stdout i
-        done;
-    | _ -> failwith "give ml or mli")
-    "gen_phantom [ml|mli]"
-
-
-  

File phantom.ml

  • Ignore whitespace
-type ('phantom, 'content) t = 'content
-type ('phantom, 'content) ts = 'content list
-
-module Open = struct
-  type unknown
-  let unknown : unknown = Obj.magic 0
-  let (!<) x = x
-  let (!>) x = x
-  let (!?) x = x
-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 length = List.length 
-
-let c0 = []
-let c1 t = [t]
-let c2 t1 t2 = [t1; t2]
-let c3 t1 t2 t3 = [t1; t2; t3]
-let c4 t1 t2 t3 t4 = [t1; t2; t3; t4]
-let c5 t1 t2 t3 t4 t5 = [t1; t2; t3; t4; t5]
-let c6 t1 t2 t3 t4 t5 t6 = [t1; t2; t3; t4; t5; t6]
-let c7 t1 t2 t3 t4 t5 t6 t7 = [t1; t2; t3; t4; t5; t6; t7]
-let c8 t1 t2 t3 t4 t5 t6 t7 t8 = [t1; t2; t3; t4; t5; t6; t7; t8]
-let c9 t1 t2 t3 t4 t5 t6 t7 t8 t9 = [t1; t2; t3; t4; t5; t6; t7; t8; t9]
-let c10 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 = [t1; t2; t3; t4; t5; t6; t7; t8; t9; t10]
-
-let d1 = function [t] -> t | _ -> assert false
-let d2 = function [t1; t2] -> (t1, t2) | _ -> assert false
-let d3 = function [t1; t2; t3] -> (t1, t2, t3) | _ -> assert false
-let d4 = function [t1; t2; t3; t4] -> (t1, t2, t3, t4) | _ -> assert false
-let d5 = function [t1; t2; t3; t4; t5] -> (t1, t2, t3, t4, t5) | _ -> assert false
-let d6 = function [t1; t2; t3; t4; t5; t6] -> (t1, t2, t3, t4, t5, t6) | _ -> assert false
-let d7 = function [t1; t2; t3; t4; t5; t6; t7] -> (t1, t2, t3, t4, t5, t6, t7) | _ -> assert false
-let d8 = function [t1; t2; t3; t4; t5; t6; t7; t8] -> (t1, t2, t3, t4, t5, t6, t7, t8) | _ -> assert false
-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

File phantom.mli

  • Ignore whitespace
-type ('phantom, 'cont) t
-
-(* Rather than open Phantom, I recommend to open Phantom.Open *)
-module Open : sig
-  type unknown 
-  val unknown : unknown
-  val (!<) : ('a, 'cont) t -> 'cont
-  (** Forget the phantom *)
-  val (!>) : 'cont -> (unknown, 'cont) t
-  (** Safe lift up with the unknown phantom *)
-  val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
-  (** Forget the phantom *)
-end
-type unknown = Open.unknown
-val unknown : Open.unknown
-val (!<) : ('a, 'cont) t -> 'cont
-val (!>) : 'cont -> (unknown, 'cont) t
-val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
-
-val unsafe : 'cont -> ('unsafe, 'cont) t
-(** [unsafe v] lifts up [v] of [elt] to one with any phantom. Use with care. *)
-val magic : ('a, 'cont) t -> ('unsafe, 'cont) t
-(** [magic v] changes the phantom ov [v]. Use with care. *)
-
-type ('phantom, 'cont) ts
-  (* 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
-
-(* This encoding is correct only if the parameter cannot be the unit or a tuple *)
-val c0 : (unit, 'cont) ts
-val c1 : ('a1, 'cont) t -> ('a1, 'cont) ts
-val c2 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a1 * 'a2, 'cont) ts
-val c3 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a3, 'cont) t -> ('a1 * 'a2 * 'a3, 'cont) ts
-val c4 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a3, 'cont) t -> ('a4, 'cont) t -> ('a1 * 'a2 * 'a3 * 'a4, 'cont) ts
-val c5 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a3, 'cont) t -> ('a4, 'cont) t -> ('a5, 'cont) t -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5, 'cont) ts
-val c6 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a3, 'cont) t -> ('a4, 'cont) t -> ('a5, 'cont) t -> ('a6, 'cont) t -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6, 'cont) ts
-val c7 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a3, 'cont) t -> ('a4, 'cont) t -> ('a5, 'cont) t -> ('a6, 'cont) t -> ('a7, 'cont) t -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7, 'cont) ts
-val c8 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a3, 'cont) t -> ('a4, 'cont) t -> ('a5, 'cont) t -> ('a6, 'cont) t -> ('a7, 'cont) t -> ('a8, 'cont) t -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8, 'cont) ts
-val c9 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a3, 'cont) t -> ('a4, 'cont) t -> ('a5, 'cont) t -> ('a6, 'cont) t -> ('a7, 'cont) t -> ('a8, 'cont) t -> ('a9, 'cont) t -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9, 'cont) ts
-val c10 : ('a1, 'cont) t -> ('a2, 'cont) t -> ('a3, 'cont) t -> ('a4, 'cont) t -> ('a5, 'cont) t -> ('a6, 'cont) t -> ('a7, 'cont) t -> ('a8, 'cont) t -> ('a9, 'cont) t -> ('a10, 'cont) t -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10, 'cont) ts
-
-val d1 : ('a1, 'cont) ts -> ('a1, 'cont) t
-val d2 : ('a1 * 'a2, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t
-val d3 : ('a1 * 'a2 * 'a3, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t * ('a3, 'cont) t
-val d4 : ('a1 * 'a2 * 'a3 * 'a4, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t * ('a3, 'cont) t * ('a4, 'cont) t
-val d5 : ('a1 * 'a2 * 'a3 * 'a4 * 'a5, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t * ('a3, 'cont) t * ('a4, 'cont) t * ('a5, 'cont) t
-val d6 : ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t * ('a3, 'cont) t * ('a4, 'cont) t * ('a5, 'cont) t * ('a6, 'cont) t
-val d7 : ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t * ('a3, 'cont) t * ('a4, 'cont) t * ('a5, 'cont) t * ('a6, 'cont) t * ('a7, 'cont) t
-val d8 : ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t * ('a3, 'cont) t * ('a4, 'cont) t * ('a5, 'cont) t * ('a6, 'cont) t * ('a7, 'cont) t * ('a8, 'cont) t
-val d9 : ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t * ('a3, 'cont) t * ('a4, 'cont) t * ('a5, 'cont) t * ('a6, 'cont) t * ('a7, 'cont) t * ('a8, 'cont) t * ('a9, 'cont) t
-val d10 : ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10, 'cont) ts -> ('a1, 'cont) t * ('a2, 'cont) t * ('a3, 'cont) t * ('a4, 'cont) t * ('a5, 'cont) t * ('a6, 'cont) t * ('a7, 'cont) t * ('a8, 'cont) t * ('a9, 'cont) t * ('a10, 'cont) t

File phantom2_head.ml

  • Ignore whitespace
-type unknown
-
-type ('phantom, 'content) t = 'content
-
-let (!<) x = x
-let (!>) x = x
-let (!?) x = x
-let unsafe x = x
-let magic x = x
-

File phantom2_head.mli

  • Ignore whitespace
-type unknown
-  (** unknown tag *)
- 
-type ('phantom, 'content) t 
-  (** phantom type of 'content *)
-
-val (!<) : ('phantom, 'content) t -> 'content
-  (** downcast *)
-val (!>) : 'content -> (unknown, 'content) t
-  (** lift up to an unknown *)
-val (!?) : ('phantom, 'content) t -> (unknown, 'content) t
-  (** forget about the phantom *)
-
-val unsafe : 'content -> ('phantom, 'content) t
-  (** unsafe lift up *)
-val magic : ('phantom1, 'content) t -> ('phantom2, 'content) t
-  (** unsafe replacement of phantom *)
-
-(** tsN : encoding of heterogeneous phantom tuple/list *)
-

File phantom2_tail.ml

  • Ignore whitespace
-
-let ( ** ) ts t = ts#append t
-let list t = ts0 () ** t

File phantom2_tail.mli

  • Ignore whitespace
-
-(** heterogeneous list/tuple constructors 
-
-    Usage: list t1 ** t2 ** t3 : _ ts3
-*)
-val list : ('a1, 'c) t -> ('a1, 'c) ts1
-val ( ** ) : < append : ('a, 'c) t -> 'b; .. > -> ('a, 'c) t -> 'b 

File phantom_head.ml

View file
  • Ignore whitespace
+type ('phantom, 'content) t = 'content
+type ('phantom, 'content) ts = 'content list
+
+module Open = struct
+  type unknown
+  let unknown : unknown = Obj.magic 0
+  let (!<) x = x
+  let (!>) x = x
+  let (!?) x = x
+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 length = List.length 
+
+let c0 = []
+let c1 t = [t]
+let c2 t1 t2 = [t1; t2]
+let c3 t1 t2 t3 = [t1; t2; t3]
+let c4 t1 t2 t3 t4 = [t1; t2; t3; t4]
+let c5 t1 t2 t3 t4 t5 = [t1; t2; t3; t4; t5]
+let c6 t1 t2 t3 t4 t5 t6 = [t1; t2; t3; t4; t5; t6]
+let c7 t1 t2 t3 t4 t5 t6 t7 = [t1; t2; t3; t4; t5; t6; t7]
+let c8 t1 t2 t3 t4 t5 t6 t7 t8 = [t1; t2; t3; t4; t5; t6; t7; t8]
+let c9 t1 t2 t3 t4 t5 t6 t7 t8 t9 = [t1; t2; t3; t4; t5; t6; t7; t8; t9]
+let c10 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 = [t1; t2; t3; t4; t5; t6; t7; t8; t9; t10]
+
+let d1 = function [t] -> t | _ -> assert false
+let d2 = function [t1; t2] -> (t1, t2) | _ -> assert false
+let d3 = function [t1; t2; t3] -> (t1, t2, t3) | _ -> assert false
+let d4 = function [t1; t2; t3; t4] -> (t1, t2, t3, t4) | _ -> assert false
+let d5 = function [t1; t2; t3; t4; t5] -> (t1, t2, t3, t4, t5) | _ -> assert false
+let d6 = function [t1; t2; t3; t4; t5; t6] -> (t1, t2, t3, t4, t5, t6) | _ -> assert false
+let d7 = function [t1; t2; t3; t4; t5; t6; t7] -> (t1, t2, t3, t4, t5, t6, t7) | _ -> assert false
+let d8 = function [t1; t2; t3; t4; t5; t6; t7; t8] -> (t1, t2, t3, t4, t5, t6, t7, t8) | _ -> assert false
+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 get1 l = List.nth l 1
+let get2 l = List.nth l 2
+let get3 l = List.nth l 3
+let get4 l = List.nth l 4
+let get5 l = List.nth l 5
+let get6 l = List.nth l 6
+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
+

File phantom_head.mli

View file
  • Ignore whitespace
+type ('phantom, 'cont) t
+
+(* Rather than open Phantom, I recommend to open Phantom.Open *)
+module Open : sig
+  type unknown 
+  val unknown : unknown
+  val (!<) : ('a, 'cont) t -> 'cont
+  (** Forget the phantom *)
+  val (!>) : 'cont -> (unknown, 'cont) t
+  (** Safe lift up with the unknown phantom *)
+  val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
+  (** Forget the phantom *)
+end
+type unknown = Open.unknown
+val unknown : Open.unknown
+val (!<) : ('a, 'cont) t -> 'cont
+val (!>) : 'cont -> (unknown, 'cont) t
+val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
+
+val unsafe : 'cont -> ('unsafe, 'cont) t
+(** [unsafe v] lifts up [v] of [elt] to one with any phantom. Use with care. *)
+val magic : ('a, 'cont) t -> ('unsafe, 'cont) t
+(** [magic v] changes the phantom ov [v]. Use with care. *)
+
+type ('phantom, 'cont) ts
+  (* 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
+
+(* This encoding is correct only if the parameter cannot be the unit or a tuple *)

File phantomy_head.ml

  • Ignore whitespace
-type ('phantom, 'content) t = 'content
-
-module Open = struct
-  type unknown
-  let unknown : unknown = Obj.magic 0
-  let (!<) x = x
-  let (!>) x = x
-  let (!?) x = x
-end
-include Open
-let unsafe x = x
-let magic x = x
-
-class ['content] ts (ls : 'content list) = object
-  method list = ls
-  method array = Array.of_list ls
-end
-
-let to_list (v : 'c #ts) = v#list
-let to_unknown_list (v : 'c #ts) = v#list
-let to_array (v : 'c #ts) = v#array
-let to_unknown_array (v : 'c #ts) = v#array
-let of_unknown_list (vs : (unknown, 'c) t list) : 'c ts = new ts vs
-let of_unknown_array (vs : (unknown, 'c) t array) : 'c ts = new ts (Array.to_list vs)
-let of_list (vs : 'c list) : 'c ts = new ts vs
-let of_array (vs : 'c array) : 'c ts = new ts (Array.to_list vs)
-
-let length (v : 'c #ts) = List.length v#list
-

File phantomy_head.mli

  • Ignore whitespace
-type ('phantom, 'cont) t
-
-(* Rather than open Phantom, I recommend to open Phantom.Open *)
-module Open : sig
-  type unknown 
-  val unknown : unknown
-  val (!<) : ('a, 'cont) t -> 'cont
-  (** Forget the phantom *)
-  val (!>) : 'cont -> (unknown, 'cont) t
-  (** Safe lift up with the unknown phantom *)
-  val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
-  (** Forget the phantom *)
-end
-type unknown = Open.unknown
-val unknown : Open.unknown
-val (!<) : ('a, 'cont) t -> 'cont
-val (!>) : 'cont -> (unknown, 'cont) t
-val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
-
-val unsafe : 'cont -> ('unsafe, 'cont) t
-(** [unsafe v] lifts up [v] of [elt] to one with any phantom. Use with care. *)
-val magic : ('a, 'cont) t -> ('unsafe, 'cont) t
-(** [magic v] changes the phantom ov [v]. Use with care. *)
-
-class ['a] ts : 'a list -> object method array : 'a array method list : 'a list end
-  (* phantom heterogeneous 'cont list, the base class *)
-
-(** [unsafe_list ls] lifts up [ls] of [elt list] to a list with any phantom. Use with care. *)
-val to_list : 'cont #ts -> 'cont list
-val to_unknown_list : 'cont #ts -> (unknown, 'cont) t list
-val to_array : 'cont #ts -> 'cont array
-val to_unknown_array : 'cont #ts -> (unknown, 'cont) t array
-val of_unknown_list : (unknown, 'cont) t list -> 'cont ts
-val of_unknown_array : (unknown, 'cont) t array -> 'cont ts
-val of_list : 'cont list -> 'cont ts
-val of_array : 'cont array -> 'cont ts
-val length : 'cont #ts -> int
-

File phantomz_head.ml

  • Ignore whitespace
-type ('phantom, 'content) t = 'content
-type ('phantom, 'content) ts = 'content list
-
-module Open = struct
-  type unknown
-  let unknown : unknown = Obj.magic 0
-  let (!<) x = x
-  let (!>) x = x
-  let (!?) x = x
-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 length = List.length 
-
-let c0 = []
-let c1 t = [t]
-let c2 t1 t2 = [t1; t2]
-let c3 t1 t2 t3 = [t1; t2; t3]
-let c4 t1 t2 t3 t4 = [t1; t2; t3; t4]
-let c5 t1 t2 t3 t4 t5 = [t1; t2; t3; t4; t5]
-let c6 t1 t2 t3 t4 t5 t6 = [t1; t2; t3; t4; t5; t6]
-let c7 t1 t2 t3 t4 t5 t6 t7 = [t1; t2; t3; t4; t5; t6; t7]
-let c8 t1 t2 t3 t4 t5 t6 t7 t8 = [t1; t2; t3; t4; t5; t6; t7; t8]
-let c9 t1 t2 t3 t4 t5 t6 t7 t8 t9 = [t1; t2; t3; t4; t5; t6; t7; t8; t9]
-let c10 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 = [t1; t2; t3; t4; t5; t6; t7; t8; t9; t10]
-
-let d1 = function [t] -> t | _ -> assert false
-let d2 = function [t1; t2] -> (t1, t2) | _ -> assert false
-let d3 = function [t1; t2; t3] -> (t1, t2, t3) | _ -> assert false
-let d4 = function [t1; t2; t3; t4] -> (t1, t2, t3, t4) | _ -> assert false
-let d5 = function [t1; t2; t3; t4; t5] -> (t1, t2, t3, t4, t5) | _ -> assert false
-let d6 = function [t1; t2; t3; t4; t5; t6] -> (t1, t2, t3, t4, t5, t6) | _ -> assert false
-let d7 = function [t1; t2; t3; t4; t5; t6; t7] -> (t1, t2, t3, t4, t5, t6, t7) | _ -> assert false
-let d8 = function [t1; t2; t3; t4; t5; t6; t7; t8] -> (t1, t2, t3, t4, t5, t6, t7, t8) | _ -> assert false
-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 get1 l = List.nth l 1
-let get2 l = List.nth l 2
-let get3 l = List.nth l 3
-let get4 l = List.nth l 4
-let get5 l = List.nth l 5
-let get6 l = List.nth l 6
-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
-

File phantomz_head.mli

  • Ignore whitespace
-type ('phantom, 'cont) t
-
-(* Rather than open Phantom, I recommend to open Phantom.Open *)
-module Open : sig
-  type unknown 
-  val unknown : unknown
-  val (!<) : ('a, 'cont) t -> 'cont
-  (** Forget the phantom *)
-  val (!>) : 'cont -> (unknown, 'cont) t
-  (** Safe lift up with the unknown phantom *)
-  val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
-  (** Forget the phantom *)
-end
-type unknown = Open.unknown
-val unknown : Open.unknown
-val (!<) : ('a, 'cont) t -> 'cont
-val (!>) : 'cont -> (unknown, 'cont) t
-val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
-
-val unsafe : 'cont -> ('unsafe, 'cont) t
-(** [unsafe v] lifts up [v] of [elt] to one with any phantom. Use with care. *)
-val magic : ('a, 'cont) t -> ('unsafe, 'cont) t
-(** [magic v] changes the phantom ov [v]. Use with care. *)
-
-type ('phantom, 'cont) ts
-  (* 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
-
-(* This encoding is correct only if the parameter cannot be the unit or a tuple *)

File spot.ml

View file
  • Ignore whitespace
   include Xformat
 end
 
-module Phantom = Phantomz
+module Phantom = Phantom