doc.ml

   1: (* Documentation for the col package: a syntax extension of OCaml
   2:    for the safe manipulation of flat records and their conversion
   3:    from and to text files (CSV), tuples, objects and raw string arrays.
   4: 
   5:    The advantages over using a syntax extension are the following:
   6:    - records can be defined with default values
   7:    - a "create" function is automatically defined; its arguments are labeled,
   8:      and the ones with default values are optional.
   9:    - the equivalent functions are provided for objects and tuples and one can 
  10:      convert one type into another.
  11:    - record fields of the same type can be selected at runtime.
  12:      For instance, the following "get" function takes a record and 
  13:      returns a float although the record contains fields of types 
  14:      other than float:
  15:         let get = type_float_field (if cond then "x" else "y")
  16:    - a list of records/objects/tuples can be read safely from CSV files with
  17:      a header, even if the columns are in any order and if unknown columns
  18:      are present.
  19:    - if the CSV file has no header, the columns are assumed to be in the order
  20:      of the type definition. Additional columns are ignored.
  21:    - plain English names can be given to columns labels, so that the CSV
  22:      files are ready for being manipulated in your favorite spreadsheet 
  23:      or plotting program.
  24:    - conversion of polymorphic variants without argument to and from strings
  25:      is fully automatic
  26: 
  27:    Below (file doc.ml) is a sample of code using the syntax extension.
  28:    doc.mli shows all the type definitions, submodules
  29:    and functions that are created. 
  30:    doc.ppo is the same code, after expansion by camlp4
  31:    into regular OCaml.
  32: 
  33: 
  34:    Compile with:
  35:    ocamlfind ocamlopt -c yourprogram.ml -syntax camlp4o -package col
  36: *)
  37: 
  38: 
  39: (* We define a custom type that we will use in record fields
  40:    (no syntax novelty here) *)
  41: module Date = 
  42: struct
  43:   type t = int * int
  44:   let compare (m1, y1) (m2, y2) = 
  45:     let c = compare y1 y2 in
  46:     if c <> 0 then c else compare m1 m2
  47:   let of_string s = Scanf.sscanf s "%i-%i" (fun m y -> (m, y))
  48:   let to_string (m, y) = Printf.sprintf "%02i-%i" m y
  49: end
  50: 
  51: (* A special syntax for defining a module which has the same structure
  52:    as the Date module above. See doc.mli.
  53:    It defines a "compare" function which uses the order in which
  54:    the tags appear in the type declaration. *)
  55: type tag fruit = [ `Apple | `Orange | `Banana | `Passion "Passion fruit" ]
  56: 
  57: (* The main syntax extension: it defines a record type of the same name,
  58:    plus the equivalent tuple and object types, and functions to manipulate
  59:    them. See doc.mli for the interface
  60:    and doc.ppo for the expanded OCaml code. *)
  61: type col example = {
  62:   alpha; (* field type defaults to string (builtin type) *)
  63:   bravo "Bravo!"; (* use another label in data files *)
  64:   charlie = "empty"; (* default value *)
  65:   delta : string; (* field type specification *)
  66:   echo "echo echo" : string = "nothing"; (* combining the previous features *)
  67:   foxtrot : int; (* another builtin type *)
  68:   golf : int option;
  69:   hotel : int option = Some 123;
  70:   india : float; (* another builtin type *)
  71:   juliet : float option;
  72:   kilo : bool; (* another builtin type *)
  73:   lima : bool option;
  74:   mike "date (mm-yyyy)" : Date; (* a custom type given as a module *)
  75:   november : Date option = None;
  76:   oscar : [ `Apple | `Orange ]; (* inline tag definition *)
  77:   papa : [ `Apple | `Banana ] = `Banana;
  78:   quebec : Fruit = `Passion; (* external tag definition *)
  79:   mutable romeo : int; (* mutable for records and objects, not tuples *)
  80:   (* sierra
  81:      tango
  82:      uniform
  83:      victor
  84:      whisky
  85:      x-ray
  86:      yankee
  87:      zulu *)
  88: }
  89: 
  90: (* An illustration of how to reuse record and variant types 
  91:    that are already defined.
  92: 
  93:    The Unix.stat type contains information about a given file. We want to
  94:    display this information for all the files of a directory, and sort
  95:    them the way we like.
  96: 
  97:    The following example is a program which takes a directory as argument,
  98:    and displays the full stat information on each file of the directory.
  99:    The rows are explicitely sorted so that directories (S_DIR) come before 
 100:    symbolic links (S_LNK) and regular files (S_REG).
 101: *)
 102: 
 103: (* We wrap this into a module to make things clear, but it's not necessary. *)
 104: module Test_predef =
 105: struct
 106:   (* Opening the module which provides our reused types 
 107:      stat and file_kind is necessary: *)
 108:   open Unix
 109: 
 110:   (* The order of the tags is used to define an appropriate "compare" 
 111:      function (File_kind.compare). 
 112:      The "predefined" keyword must be used to avoid redefining the type. *)
 113:   type tag file_kind = predefined
 114:     | S_CHR
 115:     | S_BLK
 116:     | S_FIFO
 117:     | S_SOCK
 118:     | S_DIR
 119:     | S_LNK
 120:     | S_REG
 121: 
 122:   (* st_kind is the only field which is not trivial. We use the File_kind
 123:      module which is created by the "type tag" definition above. *)
 124:   type col stats = predefined {
 125:     st_dev : int;
 126:     st_ino : int;
 127:     st_kind : File_kind (*Unix.file_kind*);
 128:     st_perm : int (*Unix.file_perm*);
 129:     st_nlink : int;
 130:     st_uid : int;
 131:     st_gid : int;
 132:     st_rdev : int;
 133:     st_size : int;
 134:     st_atime : float;
 135:     st_mtime : float;
 136:     st_ctime : float;
 137:   }
 138: 
 139:   (* Now we use the functions from the Stats module 
 140:      which has just been created. *)
 141: 
 142:   (* output functions *)
 143:   let print_list l =
 144:     print_endline (String.concat " " l)
 145:   let print_row (file, stats) =
 146:     print_list (file :: (Array.to_list (Stats.to_array stats)))
 147: 
 148:   (* reading the files and their stat records *)
 149:   let dir = match Sys.argv with
 150:       [| _; dir |] -> dir
 151:     | _ -> Sys.getcwd ()
 152:   let files = Array.to_list (Sys.readdir dir)
 153:   let stats = 
 154:     List.map (fun file -> (file, stat (Filename.concat dir file))) files
 155: 
 156:   (* Comparison function for stat records: 
 157:      the fields to use are given from the most important
 158:      to the least important, with the direction. `Up means the
 159:      regular (ascending) direction, while `Down means the opposite 
 160:      (descending). *)
 161:   let cmp = Stats.compare_fields [`Up "st_kind"; `Down "st_size"]
 162: 
 163:   (* As a last resort, we use the file names to sort them in case of a tie, 
 164:      and unfortunately they are not contained in the stat record
 165:      so we have to write that code: *)
 166:   let sort l =
 167:     List.sort (fun (file1, stat1) (file2, stat2) ->
 168:                  let c = cmp stat1 stat2 in
 169:                  if c <> 0 then c else String.compare file1 file2)
 170:       l
 171:   
 172:   (* Finally sort and print the result *)  
 173:   let _ =
 174:     (* header *)
 175:     print_list ("file" :: (Array.to_list Stats.fields));
 176:     (* data *)
 177:     List.iter print_row (sort stats)
 178: end 

doc.mli

   1: (* Automatically generated from doc.ml *)
   2: module Date :
   3:   sig
   4:     type t = int * int
   5:     val compare : 'a * 'b -> 'a * 'b -> int
   6:     val of_string : string -> int * int
   7:     val to_string : int * int -> string
   8:   end
   9: type fruit = [ `Apple | `Banana | `Orange | `Passion ]
  10: module Fruit :
  11:   sig
  12:     type t = fruit
  13:     exception Bad_format
  14:     val of_string : string -> [> `Apple | `Banana | `Orange | `Passion ]
  15:     val to_string : [< `Apple | `Banana | `Orange | `Passion ] -> string
  16:     val of_int : int -> [> `Apple | `Banana | `Orange | `Passion ]
  17:     val to_int : [< `Apple | `Banana | `Orange | `Passion ] -> int
  18:     val compare :
  19:       [< `Apple | `Banana | `Orange | `Passion ] ->
  20:       [< `Apple | `Banana | `Orange | `Passion ] -> int
  21:   end
  22: type example = {
  23:   alpha : string;
  24:   bravo : string;
  25:   charlie : string;
  26:   delta : string;
  27:   echo : string;
  28:   foxtrot : int;
  29:   golf : int option;
  30:   hotel : int option;
  31:   india : float;
  32:   juliet : float option;
  33:   kilo : bool;
  34:   lima : bool option;
  35:   mike : Date.t;
  36:   november : Date.t option;
  37:   oscar : [ `Apple | `Orange ];
  38:   papa : [ `Apple | `Banana ];
  39:   quebec : Fruit.t;
  40:   mutable romeo : int;
  41: }
  42: module Example :
  43:   sig
  44:     val create :
  45:       alpha:string ->
  46:       bravo:string ->
  47:       ?charlie:string ->
  48:       delta:string ->
  49:       ?echo:string ->
  50:       foxtrot:int ->
  51:       golf:int option ->
  52:       ?hotel:int option ->
  53:       india:float ->
  54:       juliet:float option ->
  55:       kilo:bool ->
  56:       lima:bool option ->
  57:       mike:Date.t ->
  58:       ?november:Date.t option ->
  59:       oscar:[ `Apple | `Orange ] ->
  60:       ?papa:[ `Apple | `Banana ] ->
  61:       ?quebec:Fruit.t -> romeo:int -> unit -> example
  62:     val create_tuple :
  63:       alpha:string ->
  64:       bravo:string ->
  65:       ?charlie:string ->
  66:       delta:string ->
  67:       ?echo:string ->
  68:       foxtrot:int ->
  69:       golf:int option ->
  70:       ?hotel:int option ->
  71:       india:float ->
  72:       juliet:float option ->
  73:       kilo:bool ->
  74:       lima:bool option ->
  75:       mike:Date.t ->
  76:       ?november:Date.t option ->
  77:       oscar:[ `Apple | `Orange ] ->
  78:       ?papa:[ `Apple | `Banana ] ->
  79:       ?quebec:Fruit.t ->
  80:       romeo:int ->
  81:       unit ->
  82:       string * string * string * string * string * int * int option *
  83:       int option * float * float option * bool * bool option * Date.t *
  84:       Date.t option * [ `Apple | `Orange ] * [ `Apple | `Banana ] * Fruit.t *
  85:       int
  86:     class obj :
  87:       alpha:string ->
  88:       bravo:string ->
  89:       ?charlie:string ->
  90:       delta:string ->
  91:       ?echo:string ->
  92:       foxtrot:int ->
  93:       golf:int option ->
  94:       ?hotel:int option ->
  95:       india:float ->
  96:       juliet:float option ->
  97:       kilo:bool ->
  98:       lima:bool option ->
  99:       mike:Date.t ->
 100:       ?november:Date.t option ->
 101:       oscar:[ `Apple | `Orange ] ->
 102:       ?papa:[ `Apple | `Banana ] ->
 103:       ?quebec:Fruit.t ->
 104:       romeo:int ->
 105:       unit ->
 106:       object
 107:         val mutable romeo : int
 108:         val quebec : Fruit.t
 109:         val papa : [ `Apple | `Banana ]
 110:         val oscar : [ `Apple | `Orange ]
 111:         val november : Date.t option
 112:         val mike : Date.t
 113:         val lima : bool option
 114:         val kilo : bool
 115:         val juliet : float option
 116:         val india : float
 117:         val hotel : int option
 118:         val golf : int option
 119:         val foxtrot : int
 120:         val echo : string
 121:         val delta : string
 122:         val charlie : string
 123:         val bravo : string
 124:         val alpha : string
 125:         method alpha : string
 126:         method bravo : string
 127:         method charlie : string
 128:         method delta : string
 129:         method echo : string
 130:         method foxtrot : int
 131:         method golf : int option
 132:         method hotel : int option
 133:         method india : float
 134:         method juliet : float option
 135:         method kilo : bool
 136:         method lima : bool option
 137:         method mike : Date.t
 138:         method november : Date.t option
 139:         method oscar : [ `Apple | `Orange ]
 140:         method papa : [ `Apple | `Banana ]
 141:         method quebec : Fruit.t
 142:         method romeo : int
 143:         method set_romeo : int -> unit
 144:       end
 145:     exception Bad_format
 146:     val alpha_of_string : string -> string
 147:     val alpha_to_string : string -> string
 148:     val bravo_of_string : string -> string
 149:     val bravo_to_string : string -> string
 150:     val charlie_of_string : string -> string
 151:     val charlie_to_string : string -> string
 152:     val delta_of_string : string -> string
 153:     val delta_to_string : string -> string
 154:     val echo_of_string : string -> string
 155:     val echo_to_string : string -> string
 156:     val foxtrot_of_string : string -> int
 157:     val foxtrot_to_string : int -> string
 158:     val golf_of_string : string -> int option
 159:     val golf_to_string : int option -> string
 160:     val hotel_of_string : string -> int option
 161:     val hotel_to_string : int option -> string
 162:     val india_of_string : string -> float
 163:     val india_to_string : float -> string
 164:     val juliet_of_string : string -> float option
 165:     val juliet_to_string : float option -> string
 166:     val kilo_of_string : string -> bool
 167:     val kilo_to_string : bool -> string
 168:     val lima_of_string : string -> bool option
 169:     val lima_to_string : bool option -> string
 170:     val mike_of_string : string -> int * int
 171:     val mike_to_string : int * int -> string
 172:     val november_of_string : string -> (int * int) option
 173:     val november_to_string : Date.t option -> string
 174:     val oscar_of_string : string -> [> `Apple | `Orange ]
 175:     val oscar_to_string : [< `Apple | `Orange ] -> string
 176:     val papa_of_string : string -> [> `Apple | `Banana ]
 177:     val papa_to_string : [< `Apple | `Banana ] -> string
 178:     val quebec_of_string :
 179:       string -> [> `Apple | `Banana | `Orange | `Passion ]
 180:     val quebec_to_string :
 181:       [< `Apple | `Banana | `Orange | `Passion ] -> string
 182:     val romeo_of_string : string -> int
 183:     val romeo_to_string : int -> string
 184:     type t = example
 185:     module Index :
 186:       sig
 187:         val alpha : int
 188:         val bravo : int
 189:         val charlie : int
 190:         val delta : int
 191:         val echo : int
 192:         val foxtrot : int
 193:         val golf : int
 194:         val hotel : int
 195:         val india : int
 196:         val juliet : int
 197:         val kilo : int
 198:         val lima : int
 199:         val mike : int
 200:         val november : int
 201:         val oscar : int
 202:         val papa : int
 203:         val quebec : int
 204:         val romeo : int
 205:       end
 206:     module Compare :
 207:       sig
 208:         val alpha : String.t -> String.t -> int
 209:         val bravo : String.t -> String.t -> int
 210:         val charlie : String.t -> String.t -> int
 211:         val delta : String.t -> String.t -> int
 212:         val echo : String.t -> String.t -> int
 213:         val foxtrot : 'a -> 'a -> int
 214:         val golf : int option -> int option -> int
 215:         val hotel : int option -> int option -> int
 216:         val india : 'a -> 'a -> int
 217:         val juliet : float option -> float option -> int
 218:         val kilo : 'a -> 'a -> int
 219:         val lima : bool option -> bool option -> int
 220:         val mike : 'a * 'b -> 'a * 'b -> int
 221:         val november : (int * int) option -> (int * int) option -> int
 222:         val oscar : [< `Apple | `Orange ] -> [< `Apple | `Orange ] -> int
 223:         val papa : [< `Apple | `Banana ] -> [< `Apple | `Banana ] -> int
 224:         val quebec :
 225:           [< `Apple | `Banana | `Orange | `Passion ] ->
 226:           [< `Apple | `Banana | `Orange | `Passion ] -> int
 227:         val romeo : 'a -> 'a -> int
 228:       end
 229:     val fields : string array
 230:     val labels : string array
 231:     val of_array : string array -> example
 232:     val to_array : example -> string array
 233:     exception Invalid_field of string
 234:     exception Invalid_label of string
 235:     val type_string_field : string -> t -> string
 236:     val type_string_label : string -> t -> string
 237:     val type_float_field : string -> t -> float
 238:     val type_float_label : string -> t -> float
 239:     val type_Fruit_field : string -> t -> Fruit.t
 240:     val type_Fruit_label : string -> t -> Fruit.t
 241:     val type_Date_field : string -> t -> Date.t
 242:     val type_Date_label : string -> t -> Date.t
 243:     val type_Date_option_field : string -> t -> Date.t option
 244:     val type_Date_option_label : string -> t -> Date.t option
 245:     val type_int_option_field : string -> t -> int option
 246:     val type_int_option_label : string -> t -> int option
 247:     val type_float_option_field : string -> t -> float option
 248:     val type_float_option_label : string -> t -> float option
 249:     val type_bool_option_field : string -> t -> bool option
 250:     val type_bool_option_label : string -> t -> bool option
 251:     val type_bool_field : string -> t -> bool
 252:     val type_bool_label : string -> t -> bool
 253:     val type_int_field : string -> t -> int
 254:     val type_int_label : string -> t -> int
 255:     val load_csv_rows :
 256:       ?strict:bool -> ?noheader:bool -> string -> (example -> unit) -> unit
 257:     val load_csv :
 258:       ?strict:bool -> ?noheader:bool -> ?rev:bool -> string -> example list
 259:     val open_out_csv :
 260:       ?sep:char ->
 261:       ?noheader:bool -> string -> (example -> unit) * (unit -> unit)
 262:     val save_csv_rows :
 263:       ?sep:char ->
 264:       ?noheader:bool -> string -> (unit -> example option) -> unit
 265:     val save_csv :
 266:       ?sep:char -> ?noheader:bool -> string -> example list -> unit
 267:     val compare_fields :
 268:       [< `Custom of example -> example -> int
 269:        | `Down of string
 270:        | `Up of string ]
 271:       list -> example -> example -> int
 272:     val compare_labels :
 273:       [< `Custom of example -> example -> int
 274:        | `Down of string
 275:        | `Up of string ]
 276:       list -> example -> example -> int
 277:     module Tup :
 278:       sig
 279:         type t =
 280:           string * string * string * string * string * int * int option *
 281:           int option * float * float option * bool * bool option * Date.t *
 282:           Date.t option * [ `Apple | `Orange ] * [ `Apple | `Banana ] *
 283:           Fruit.t * int
 284:         val create :
 285:           alpha:string ->
 286:           bravo:string ->
 287:           ?charlie:string ->
 288:           delta:string ->
 289:           ?echo:string ->
 290:           foxtrot:int ->
 291:           golf:int option ->
 292:           ?hotel:int option ->
 293:           india:float ->
 294:           juliet:float option ->
 295:           kilo:bool ->
 296:           lima:bool option ->
 297:           mike:Date.t ->
 298:           ?november:Date.t option ->
 299:           oscar:[ `Apple | `Orange ] ->
 300:           ?papa:[ `Apple | `Banana ] ->
 301:           ?quebec:Fruit.t ->
 302:           romeo:int ->
 303:           unit ->
 304:           string * string * string * string * string * int * int option *
 305:           int option * float * float option * bool * bool option * Date.t *
 306:           Date.t option * [ `Apple | `Orange ] * [ `Apple | `Banana ] *
 307:           Fruit.t * int
 308:         val of_array :
 309:           string array ->
 310:           string * string * string * string * string * int * int option *
 311:           int option * float * float option * bool * bool option *
 312:           (int * int) * (int * int) option * [> `Apple | `Orange ] *
 313:           [> `Apple | `Banana ] *
 314:           [> `Apple | `Banana | `Orange | `Passion ] * int
 315:         val to_array :
 316:           string * string * string * string * string * int * int option *
 317:           int option * float * float option * bool * bool option *
 318:           (int * int) * Date.t option * [< `Apple | `Orange ] *
 319:           [< `Apple | `Banana ] *
 320:           [< `Apple | `Banana | `Orange | `Passion ] * int -> string array
 321:         val of_record : example -> t
 322:         val to_record : t -> example
 323:         val get_alpha : t -> string
 324:         val get_bravo : t -> string
 325:         val get_charlie : t -> string
 326:         val get_delta : t -> string
 327:         val get_echo : t -> string
 328:         val get_foxtrot : t -> int
 329:         val get_golf : t -> int option
 330:         val get_hotel : t -> int option
 331:         val get_india : t -> float
 332:         val get_juliet : t -> float option
 333:         val get_kilo : t -> bool
 334:         val get_lima : t -> bool option
 335:         val get_mike : t -> Date.t
 336:         val get_november : t -> Date.t option
 337:         val get_oscar : t -> [ `Apple | `Orange ]
 338:         val get_papa : t -> [ `Apple | `Banana ]
 339:         val get_quebec : t -> Fruit.t
 340:         val get_romeo : t -> int
 341:         exception Invalid_field of string
 342:         exception Invalid_label of string
 343:         val type_string_field : string -> t -> string
 344:         val type_string_label : string -> t -> string
 345:         val type_float_field : string -> t -> float
 346:         val type_float_label : string -> t -> float
 347:         val type_Fruit_field : string -> t -> Fruit.t
 348:         val type_Fruit_label : string -> t -> Fruit.t
 349:         val type_Date_field : string -> t -> Date.t
 350:         val type_Date_label : string -> t -> Date.t
 351:         val type_Date_option_field : string -> t -> Date.t option
 352:         val type_Date_option_label : string -> t -> Date.t option
 353:         val type_int_option_field : string -> t -> int option
 354:         val type_int_option_label : string -> t -> int option
 355:         val type_float_option_field : string -> t -> float option
 356:         val type_float_option_label : string -> t -> float option
 357:         val type_bool_option_field : string -> t -> bool option
 358:         val type_bool_option_label : string -> t -> bool option
 359:         val type_bool_field : string -> t -> bool
 360:         val type_bool_label : string -> t -> bool
 361:         val type_int_field : string -> t -> int
 362:         val type_int_label : string -> t -> int
 363:         val load_csv_rows :
 364:           ?strict:bool ->
 365:           ?noheader:bool ->
 366:           string ->
 367:           (string * string * string * string * string * int * int option *
 368:            int option * float * float option * bool * bool option *
 369:            (int * int) * (int * int) option * [> `Apple | `Orange ] *
 370:            [> `Apple | `Banana ] *
 371:            [> `Apple | `Banana | `Orange | `Passion ] * int -> unit) ->
 372:           unit
 373:         val load_csv :
 374:           ?strict:bool ->
 375:           ?noheader:bool ->
 376:           ?rev:bool ->
 377:           string ->
 378:           (string * string * string * string * string * int * int option *
 379:            int option * float * float option * bool * bool option *
 380:            (int * int) * (int * int) option * [> `Apple | `Orange ] *
 381:            [> `Apple | `Banana ] *
 382:            [> `Apple | `Banana | `Orange | `Passion ] * int)
 383:           list
 384:         val open_out_csv :
 385:           ?sep:char ->
 386:           ?noheader:bool ->
 387:           string ->
 388:           (string * string * string * string * string * int * int option *
 389:            int option * float * float option * bool * bool option *
 390:            (int * int) * Date.t option * [< `Apple | `Orange ] *
 391:            [< `Apple | `Banana ] *
 392:            [< `Apple | `Banana | `Orange | `Passion ] * int -> unit) *
 393:           (unit -> unit)
 394:         val save_csv_rows :
 395:           ?sep:char ->
 396:           ?noheader:bool ->
 397:           string ->
 398:           (unit ->
 399:            (string * string * string * string * string * int * int option *
 400:             int option * float * float option * bool * bool option *
 401:             (int * int) * Date.t option * [< `Apple | `Orange ] *
 402:             [< `Apple | `Banana ] *
 403:             [< `Apple | `Banana | `Orange | `Passion ] * int)
 404:            option) ->
 405:           unit
 406:         val save_csv :
 407:           ?sep:char ->
 408:           ?noheader:bool ->
 409:           string ->
 410:           (string * string * string * string * string * int * int option *
 411:            int option * float * float option * bool * bool option *
 412:            (int * int) * Date.t option * [< `Apple | `Orange ] *
 413:            [< `Apple | `Banana ] *
 414:            [< `Apple | `Banana | `Orange | `Passion ] * int)
 415:           list -> unit
 416:         val compare_fields :
 417:           [< `Custom of t -> t -> int | `Down of string | `Up of string ]
 418:           list -> t -> t -> int
 419:         val compare_labels :
 420:           [< `Custom of t -> t -> int | `Down of string | `Up of string ]
 421:           list -> t -> t -> int
 422:       end
 423:     module OO :
 424:       sig
 425:         class t :
 426:           alpha:string ->
 427:           bravo:string ->
 428:           ?charlie:string ->
 429:           delta:string ->
 430:           ?echo:string ->
 431:           foxtrot:int ->
 432:           golf:int option ->
 433:           ?hotel:int option ->
 434:           india:float ->
 435:           juliet:float option ->
 436:           kilo:bool ->
 437:           lima:bool option ->
 438:           mike:Date.t ->
 439:           ?november:Date.t option ->
 440:           oscar:[ `Apple | `Orange ] ->
 441:           ?papa:[ `Apple | `Banana ] ->
 442:           ?quebec:Fruit.t -> romeo:int -> unit -> obj
 443:         val create :
 444:           alpha:string ->
 445:           bravo:string ->
 446:           ?charlie:string ->
 447:           delta:string ->
 448:           ?echo:string ->
 449:           foxtrot:int ->
 450:           golf:int option ->
 451:           ?hotel:int option ->
 452:           india:float ->
 453:           juliet:float option ->
 454:           kilo:bool ->
 455:           lima:bool option ->
 456:           mike:Date.t ->
 457:           ?november:Date.t option ->
 458:           oscar:[ `Apple | `Orange ] ->
 459:           ?papa:[ `Apple | `Banana ] ->
 460:           ?quebec:Fruit.t -> romeo:int -> unit -> t
 461:         val of_array : string array -> t
 462:         val to_array :
 463:           < alpha : string; bravo : string; charlie : string; delta : 
 464:             string; echo : string; foxtrot : int; golf : int option;
 465:             hotel : int option; india : float; juliet : float option;
 466:             kilo : bool; lima : bool option; mike : int * int;
 467:             november : Date.t option; oscar : [< `Apple | `Orange ];
 468:             papa : [< `Apple | `Banana ];
 469:             quebec : [< `Apple | `Banana | `Orange | `Passion ]; romeo : 
 470:             int; .. > ->
 471:           string array
 472:         val of_record : example -> t
 473:         val to_record :
 474:           < alpha : string; bravo : string; charlie : string; delta : 
 475:             string; echo : string; foxtrot : int; golf : int option;
 476:             hotel : int option; india : float; juliet : float option;
 477:             kilo : bool; lima : bool option; mike : Date.t;
 478:             november : Date.t option; oscar : [ `Apple | `Orange ];
 479:             papa : [ `Apple | `Banana ]; quebec : Fruit.t; romeo : int; .. > ->
 480:           example
 481:         exception Invalid_field of string
 482:         exception Invalid_label of string
 483:         val type_string_field : string -> t -> string
 484:         val type_string_label : string -> t -> string
 485:         val type_float_field : string -> t -> float
 486:         val type_float_label : string -> t -> float
 487:         val type_Fruit_field : string -> t -> Fruit.t
 488:         val type_Fruit_label : string -> t -> Fruit.t
 489:         val type_Date_field : string -> t -> Date.t
 490:         val type_Date_label : string -> t -> Date.t
 491:         val type_Date_option_field : string -> t -> Date.t option
 492:         val type_Date_option_label : string -> t -> Date.t option
 493:         val type_int_option_field : string -> t -> int option
 494:         val type_int_option_label : string -> t -> int option
 495:         val type_float_option_field : string -> t -> float option
 496:         val type_float_option_label : string -> t -> float option
 497:         val type_bool_option_field : string -> t -> bool option
 498:         val type_bool_option_label : string -> t -> bool option
 499:         val type_bool_field : string -> t -> bool
 500:         val type_bool_label : string -> t -> bool
 501:         val type_int_field : string -> t -> int
 502:         val type_int_label : string -> t -> int
 503:         val load_csv_rows :
 504:           ?strict:bool -> ?noheader:bool -> string -> (t -> unit) -> unit
 505:         val load_csv :
 506:           ?strict:bool -> ?noheader:bool -> ?rev:bool -> string -> t list
 507:         val open_out_csv :
 508:           ?sep:char ->
 509:           ?noheader:bool ->
 510:           string ->
 511:           (< alpha : string; bravo : string; charlie : string;
 512:              delta : string; echo : string; foxtrot : int; golf : int option;
 513:              hotel : int option; india : float; juliet : float option;
 514:              kilo : bool; lima : bool option; mike : int * int;
 515:              november : Date.t option; oscar : [< `Apple | `Orange ];
 516:              papa : [< `Apple | `Banana ];
 517:              quebec : [< `Apple | `Banana | `Orange | `Passion ];
 518:              romeo : int; .. > ->
 519:            unit) *
 520:           (unit -> unit)
 521:         val save_csv_rows :
 522:           ?sep:char ->
 523:           ?noheader:bool ->
 524:           string ->
 525:           (unit ->
 526:            < alpha : string; bravo : string; charlie : string;
 527:              delta : string; echo : string; foxtrot : int; golf : int option;
 528:              hotel : int option; india : float; juliet : float option;
 529:              kilo : bool; lima : bool option; mike : int * int;
 530:              november : Date.t option; oscar : [< `Apple | `Orange ];
 531:              papa : [< `Apple | `Banana ];
 532:              quebec : [< `Apple | `Banana | `Orange | `Passion ];
 533:              romeo : int; .. >
 534:            option) ->
 535:           unit
 536:         val save_csv :
 537:           ?sep:char ->
 538:           ?noheader:bool ->
 539:           string ->
 540:           < alpha : string; bravo : string; charlie : string; delta : 
 541:             string; echo : string; foxtrot : int; golf : int option;
 542:             hotel : int option; india : float; juliet : float option;
 543:             kilo : bool; lima : bool option; mike : int * int;
 544:             november : Date.t option; oscar : [< `Apple | `Orange ];
 545:             papa : [< `Apple | `Banana ];
 546:             quebec : [< `Apple | `Banana | `Orange | `Passion ]; romeo : 
 547:             int; .. >
 548:           list -> unit
 549:         val compare_fields :
 550:           [< `Custom of
 551:                (< alpha : String.t; bravo : String.t; charlie : String.t;
 552:                   delta : String.t; echo : String.t; foxtrot : 'b;
 553:                   golf : int option; hotel : int option; india : 'c;
 554:                   juliet : float option; kilo : 'd; lima : bool option;
 555:                   mike : 'e * 'f; november : (int * int) option;
 556:                   oscar : [< `Apple | `Orange ];
 557:                   papa : [< `Apple | `Banana ];
 558:                   quebec : [< `Apple | `Banana | `Orange | `Passion ];
 559:                   romeo : 'g; .. >
 560:                 as 'a) ->
 561:                (< alpha : String.t; bravo : String.t; charlie : String.t;
 562:                   delta : String.t; echo : String.t; foxtrot : 'b;
 563:                   golf : int option; hotel : int option; india : 'c;
 564:                   juliet : float option; kilo : 'd; lima : bool option;
 565:                   mike : 'e * 'f; november : (int * int) option;
 566:                   oscar : [< `Apple | `Orange ];
 567:                   papa : [< `Apple | `Banana ];
 568:                   quebec : [< `Apple | `Banana | `Orange | `Passion ];
 569:                   romeo : 'g; .. >
 570:                 as 'h) ->
 571:                int
 572:            | `Down of string
 573:            | `Up of string ]
 574:           list -> 'a -> 'h -> int
 575:         val compare_labels :
 576:           [< `Custom of
 577:                (< alpha : String.t; bravo : String.t; charlie : String.t;
 578:                   delta : String.t; echo : String.t; foxtrot : 'b;
 579:                   golf : int option; hotel : int option; india : 'c;
 580:                   juliet : float option; kilo : 'd; lima : bool option;
 581:                   mike : 'e * 'f; november : (int * int) option;
 582:                   oscar : [< `Apple | `Orange ];
 583:                   papa : [< `Apple | `Banana ];
 584:                   quebec : [< `Apple | `Banana | `Orange | `Passion ];
 585:                   romeo : 'g; .. >
 586:                 as 'a) ->
 587:                (< alpha : String.t; bravo : String.t; charlie : String.t;
 588:                   delta : String.t; echo : String.t; foxtrot : 'b;
 589:                   golf : int option; hotel : int option; india : 'c;
 590:                   juliet : float option; kilo : 'd; lima : bool option;
 591:                   mike : 'e * 'f; november : (int * int) option;
 592:                   oscar : [< `Apple | `Orange ];
 593:                   papa : [< `Apple | `Banana ];
 594:                   quebec : [< `Apple | `Banana | `Orange | `Passion ];
 595:                   romeo : 'g; .. >
 596:                 as 'h) ->
 597:                int
 598:            | `Down of string
 599:            | `Up of string ]
 600:           list -> 'a -> 'h -> int
 601:       end
 602:   end
 603: module Test_predef :
 604:   sig
 605:     module File_kind :
 606:       sig
 607:         type t = Unix.file_kind
 608:         exception Bad_format
 609:         val of_string : string -> Unix.file_kind
 610:         val to_string : Unix.file_kind -> string
 611:         val of_int : int -> Unix.file_kind
 612:         val to_int : Unix.file_kind -> int
 613:         val compare : Unix.file_kind -> Unix.file_kind -> int
 614:       end
 615:     module Stats :
 616:       sig
 617:         val create :
 618:           st_dev:int ->
 619:           st_ino:int ->
 620:           st_kind:Unix.file_kind ->
 621:           st_perm:Unix.file_perm ->
 622:           st_nlink:int ->
 623:           st_uid:int ->
 624:           st_gid:int ->
 625:           st_rdev:int ->
 626:           st_size:int ->
 627:           st_atime:float ->
 628:           st_mtime:float -> st_ctime:float -> unit -> Unix.stats
 629:         val create_tuple :
 630:           st_dev:int ->
 631:           st_ino:int ->
 632:           st_kind:File_kind.t ->
 633:           st_perm:int ->
 634:           st_nlink:int ->
 635:           st_uid:int ->
 636:           st_gid:int ->
 637:           st_rdev:int ->
 638:           st_size:int ->
 639:           st_atime:float ->
 640:           st_mtime:float ->
 641:           st_ctime:float ->
 642:           unit ->
 643:           int * int * File_kind.t * int * int * int * int * int * int *
 644:           float * float * float
 645:         class obj :
 646:           st_dev:int ->
 647:           st_ino:int ->
 648:           st_kind:File_kind.t ->
 649:           st_perm:int ->
 650:           st_nlink:int ->
 651:           st_uid:int ->
 652:           st_gid:int ->
 653:           st_rdev:int ->
 654:           st_size:int ->
 655:           st_atime:float ->
 656:           st_mtime:float ->
 657:           st_ctime:float ->
 658:           unit ->
 659:           object
 660:             val st_uid : int
 661:             val st_size : int
 662:             val st_rdev : int
 663:             val st_perm : int
 664:             val st_nlink : int
 665:             val st_mtime : float
 666:             val st_kind : File_kind.t
 667:             val st_ino : int
 668:             val st_gid : int
 669:             val st_dev : int
 670:             val st_ctime : float
 671:             val st_atime : float
 672:             method st_atime : float
 673:             method st_ctime : float
 674:             method st_dev : int
 675:             method st_gid : int
 676:             method st_ino : int
 677:             method st_kind : File_kind.t
 678:             method st_mtime : float
 679:             method st_nlink : int
 680:             method st_perm : int
 681:             method st_rdev : int
 682:             method st_size : int
 683:             method st_uid : int
 684:           end
 685:         exception Bad_format
 686:         val st_dev_of_string : string -> int
 687:         val st_dev_to_string : int -> string
 688:         val st_ino_of_string : string -> int
 689:         val st_ino_to_string : int -> string
 690:         val st_kind_of_string : string -> Unix.file_kind
 691:         val st_kind_to_string : Unix.file_kind -> string
 692:         val st_perm_of_string : string -> int
 693:         val st_perm_to_string : int -> string
 694:         val st_nlink_of_string : string -> int
 695:         val st_nlink_to_string : int -> string
 696:         val st_uid_of_string : string -> int
 697:         val st_uid_to_string : int -> string
 698:         val st_gid_of_string : string -> int
 699:         val st_gid_to_string : int -> string
 700:         val st_rdev_of_string : string -> int
 701:         val st_rdev_to_string : int -> string
 702:         val st_size_of_string : string -> int
 703:         val st_size_to_string : int -> string
 704:         val st_atime_of_string : string -> float
 705:         val st_atime_to_string : float -> string
 706:         val st_mtime_of_string : string -> float
 707:         val st_mtime_to_string : float -> string
 708:         val st_ctime_of_string : string -> float
 709:         val st_ctime_to_string : float -> string
 710:         type t = Unix.stats
 711:         module Index :
 712:           sig
 713:             val st_dev : int
 714:             val st_ino : int
 715:             val st_kind : int
 716:             val st_perm : int
 717:             val st_nlink : int
 718:             val st_uid : int
 719:             val st_gid : int
 720:             val st_rdev : int
 721:             val st_size : int
 722:             val st_atime : int
 723:             val st_mtime : int
 724:             val st_ctime : int
 725:           end
 726:         module Compare :
 727:           sig
 728:             val st_dev : 'a -> 'a -> int
 729:             val st_ino : 'a -> 'a -> int
 730:             val st_kind : Unix.file_kind -> Unix.file_kind -> int
 731:             val st_perm : 'a -> 'a -> int
 732:             val st_nlink : 'a -> 'a -> int
 733:             val st_uid : 'a -> 'a -> int
 734:             val st_gid : 'a -> 'a -> int
 735:             val st_rdev : 'a -> 'a -> int
 736:             val st_size : 'a -> 'a -> int
 737:             val st_atime : 'a -> 'a -> int
 738:             val st_mtime : 'a -> 'a -> int
 739:             val st_ctime : 'a -> 'a -> int
 740:           end
 741:         val fields : string array
 742:         val labels : string array
 743:         val of_array : string array -> Unix.stats
 744:         val to_array : Unix.stats -> string array
 745:         exception Invalid_field of string
 746:         exception Invalid_label of string
 747:         val type_float_field : string -> t -> float
 748:         val type_float_label : string -> t -> float
 749:         val type_File_kind_field : string -> t -> Unix.file_kind
 750:         val type_File_kind_label : string -> t -> Unix.file_kind
 751:         val type_int_field : string -> t -> Unix.file_perm
 752:         val type_int_label : string -> t -> Unix.file_perm
 753:         val load_csv_rows :
 754:           ?strict:bool ->
 755:           ?noheader:bool -> string -> (Unix.stats -> unit) -> unit
 756:         val load_csv :
 757:           ?strict:bool ->
 758:           ?noheader:bool -> ?rev:bool -> string -> Unix.stats list
 759:         val open_out_csv :
 760:           ?sep:char ->
 761:           ?noheader:bool -> string -> (Unix.stats -> unit) * (unit -> unit)
 762:         val save_csv_rows :
 763:           ?sep:char ->
 764:           ?noheader:bool -> string -> (unit -> Unix.stats option) -> unit
 765:         val save_csv :
 766:           ?sep:char -> ?noheader:bool -> string -> Unix.stats list -> unit
 767:         val compare_fields :
 768:           [< `Custom of Unix.stats -> Unix.stats -> int
 769:            | `Down of string
 770:            | `Up of string ]
 771:           list -> Unix.stats -> Unix.stats -> int
 772:         val compare_labels :
 773:           [< `Custom of Unix.stats -> Unix.stats -> int
 774:            | `Down of string
 775:            | `Up of string ]
 776:           list -> Unix.stats -> Unix.stats -> int
 777:         module Tup :
 778:           sig
 779:             type t =
 780:               int * int * File_kind.t * int * int * int * int * int * 
 781:               int * float * float * float
 782:             val create :
 783:               st_dev:int ->
 784:               st_ino:int ->
 785:               st_kind:File_kind.t ->
 786:               st_perm:int ->
 787:               st_nlink:int ->
 788:               st_uid:int ->
 789:               st_gid:int ->
 790:               st_rdev:int ->
 791:               st_size:int ->
 792:               st_atime:float ->
 793:               st_mtime:float ->
 794:               st_ctime:float ->
 795:               unit ->
 796:               int * int * File_kind.t * int * int * int * int * int * 
 797:               int * float * float * float
 798:             val of_array :
 799:               string array ->
 800:               int * int * Unix.file_kind * int * int * int * int * int *
 801:               int * float * float * float
 802:             val to_array :
 803:               int * int * Unix.file_kind * int * int * int * int * int *
 804:               int * float * float * float -> string array
 805:             val of_record : Unix.stats -> t
 806:             val to_record : t -> Unix.stats
 807:             val get_st_dev : t -> int
 808:             val get_st_ino : t -> int
 809:             val get_st_kind : t -> File_kind.t
 810:             val get_st_perm : t -> int
 811:             val get_st_nlink : t -> int
 812:             val get_st_uid : t -> int
 813:             val get_st_gid : t -> int
 814:             val get_st_rdev : t -> int
 815:             val get_st_size : t -> int
 816:             val get_st_atime : t -> float
 817:             val get_st_mtime : t -> float
 818:             val get_st_ctime : t -> float
 819:             exception Invalid_field of string
 820:             exception Invalid_label of string
 821:             val type_float_field : string -> t -> float
 822:             val type_float_label : string -> t -> float
 823:             val type_File_kind_field : string -> t -> File_kind.t
 824:             val type_File_kind_label : string -> t -> File_kind.t
 825:             val type_int_field : string -> t -> int
 826:             val type_int_label : string -> t -> int
 827:             val load_csv_rows :
 828:               ?strict:bool ->
 829:               ?noheader:bool ->
 830:               string ->
 831:               (int * int * Unix.file_kind * int * int * int * int * int *
 832:                int * float * float * float -> unit) ->
 833:               unit
 834:             val load_csv :
 835:               ?strict:bool ->
 836:               ?noheader:bool ->
 837:               ?rev:bool ->
 838:               string ->
 839:               (int * int * Unix.file_kind * int * int * int * int * int *
 840:                int * float * float * float)
 841:               list
 842:             val open_out_csv :
 843:               ?sep:char ->
 844:               ?noheader:bool ->
 845:               string ->
 846:               (int * int * Unix.file_kind * int * int * int * int * int *
 847:                int * float * float * float -> unit) *
 848:               (unit -> unit)
 849:             val save_csv_rows :
 850:               ?sep:char ->
 851:               ?noheader:bool ->
 852:               string ->
 853:               (unit ->
 854:                (int * int * Unix.file_kind * int * int * int * int * 
 855:                 int * int * float * float * float)
 856:                option) ->
 857:               unit
 858:             val save_csv :
 859:               ?sep:char ->
 860:               ?noheader:bool ->
 861:               string ->
 862:               (int * int * Unix.file_kind * int * int * int * int * int *
 863:                int * float * float * float)
 864:               list -> unit
 865:             val compare_fields :
 866:               [< `Custom of t -> t -> int | `Down of string | `Up of string ]
 867:               list -> t -> t -> int
 868:             val compare_labels :
 869:               [< `Custom of t -> t -> int | `Down of string | `Up of string ]
 870:               list -> t -> t -> int
 871:           end
 872:         module OO :
 873:           sig
 874:             class t :
 875:               st_dev:int ->
 876:               st_ino:int ->
 877:               st_kind:File_kind.t ->
 878:               st_perm:int ->
 879:               st_nlink:int ->
 880:               st_uid:int ->
 881:               st_gid:int ->
 882:               st_rdev:int ->
 883:               st_size:int ->
 884:               st_atime:float ->
 885:               st_mtime:float -> st_ctime:float -> unit -> obj
 886:             val create :
 887:               st_dev:int ->
 888:               st_ino:int ->
 889:               st_kind:File_kind.t ->
 890:               st_perm:int ->
 891:               st_nlink:int ->
 892:               st_uid:int ->
 893:               st_gid:int ->
 894:               st_rdev:int ->
 895:               st_size:int ->
 896:               st_atime:float -> st_mtime:float -> st_ctime:float -> unit -> t
 897:             val of_array : string array -> t
 898:             val to_array :
 899:               < st_atime : float; st_ctime : float; st_dev : int;
 900:                 st_gid : int; st_ino : int; st_kind : Unix.file_kind;
 901:                 st_mtime : float; st_nlink : int; st_perm : int;
 902:                 st_rdev : int; st_size : int; st_uid : int; .. > ->
 903:               string array
 904:             val of_record : Unix.stats -> t
 905:             val to_record :
 906:               < st_atime : float; st_ctime : float; st_dev : int;
 907:                 st_gid : int; st_ino : int; st_kind : Unix.file_kind;
 908:                 st_mtime : float; st_nlink : int; st_perm : Unix.file_perm;
 909:                 st_rdev : int; st_size : int; st_uid : int; .. > ->
 910:               Unix.stats
 911:             exception Invalid_field of string
 912:             exception Invalid_label of string
 913:             val type_float_field : string -> t -> float
 914:             val type_float_label : string -> t -> float
 915:             val type_File_kind_field : string -> t -> File_kind.t
 916:             val type_File_kind_label : string -> t -> File_kind.t
 917:             val type_int_field : string -> t -> int
 918:             val type_int_label : string -> t -> int
 919:             val load_csv_rows :
 920:               ?strict:bool -> ?noheader:bool -> string -> (t -> unit) -> unit
 921:             val load_csv :
 922:               ?strict:bool -> ?noheader:bool -> ?rev:bool -> string -> t list
 923:             val open_out_csv :
 924:               ?sep:char ->
 925:               ?noheader:bool ->
 926:               string ->
 927:               (< st_atime : float; st_ctime : float; st_dev : int;
 928:                  st_gid : int; st_ino : int; st_kind : Unix.file_kind;
 929:                  st_mtime : float; st_nlink : int; st_perm : int;
 930:                  st_rdev : int; st_size : int; st_uid : int; .. > ->
 931:                unit) *
 932:               (unit -> unit)
 933:             val save_csv_rows :
 934:               ?sep:char ->
 935:               ?noheader:bool ->
 936:               string ->
 937:               (unit ->
 938:                < st_atime : float; st_ctime : float; st_dev : int;
 939:                  st_gid : int; st_ino : int; st_kind : Unix.file_kind;
 940:                  st_mtime : float; st_nlink : int; st_perm : int;
 941:                  st_rdev : int; st_size : int; st_uid : int; .. >
 942:                option) ->
 943:               unit
 944:             val save_csv :
 945:               ?sep:char ->
 946:               ?noheader:bool ->
 947:               string ->
 948:               < st_atime : float; st_ctime : float; st_dev : int;
 949:                 st_gid : int; st_ino : int; st_kind : Unix.file_kind;
 950:                 st_mtime : float; st_nlink : int; st_perm : int;
 951:                 st_rdev : int; st_size : int; st_uid : int; .. >
 952:               list -> unit
 953:             val compare_fields :
 954:               [< `Custom of
 955:                    (< st_atime : 'b; st_ctime : 'c; st_dev : 'd; st_gid : 'e;
 956:                       st_ino : 'f; st_kind : Unix.file_kind; st_mtime : 'g;
 957:                       st_nlink : 'h; st_perm : 'i; st_rdev : 'j;
 958:                       st_size : 'k; st_uid : 'l; .. >
 959:                     as 'a) ->
 960:                    (< st_atime : 'b; st_ctime : 'c; st_dev : 'd; st_gid : 'e;
 961:                       st_ino : 'f; st_kind : Unix.file_kind; st_mtime : 'g;
 962:                       st_nlink : 'h; st_perm : 'i; st_rdev : 'j;
 963:                       st_size : 'k; st_uid : 'l; .. >
 964:                     as 'm) ->
 965:                    int
 966:                | `Down of string
 967:                | `Up of string ]
 968:               list -> 'a -> 'm -> int
 969:             val compare_labels :
 970:               [< `Custom of
 971:                    (< st_atime : 'b; st_ctime : 'c; st_dev : 'd; st_gid : 'e;
 972:                       st_ino : 'f; st_kind : Unix.file_kind; st_mtime : 'g;
 973:                       st_nlink : 'h; st_perm : 'i; st_rdev : 'j;
 974:                       st_size : 'k; st_uid : 'l; .. >
 975:                     as 'a) ->
 976:                    (< st_atime : 'b; st_ctime : 'c; st_dev : 'd; st_gid : 'e;
 977:                       st_ino : 'f; st_kind : Unix.file_kind; st_mtime : 'g;
 978:                       st_nlink : 'h; st_perm : 'i; st_rdev : 'j;
 979:                       st_size : 'k; st_uid : 'l; .. >
 980:                     as 'm) ->
 981:                    int
 982:                | `Down of string
 983:                | `Up of string ]
 984:               list -> 'a -> 'm -> int
 985:           end
 986:       end
 987:     val print_list : string list -> unit
 988:     val print_row : string * Unix.stats -> unit
 989:     val dir : string
 990:     val files : string list
 991:     val stats : (string * Unix.stats) list
 992:     val cmp : Unix.stats -> Unix.stats -> int
 993:     val sort : (String.t * Unix.stats) list -> (String.t * Unix.stats) list
 994:   end

doc.ppo

   1: (* Documentation for the col package: a syntax extension of OCaml
   2:    for the safe manipulation of flat records and their conversion
   3:    from and to text files (CSV), tuples, objects and raw string arrays.
   4: 
   5:    The advantages over using a syntax extension are the following:
   6:    - records can be defined with default values
   7:    - a "create" function is automatically defined; its arguments are labeled,
   8:      and the ones with default values are optional.
   9:    - the equivalent functions are provided for objects and tuples and one can 
  10:      convert one type into another.
  11:    - record fields of the same type can be selected at runtime.
  12:      For instance, the following "get" function takes a record and 
  13:      returns a float although the record contains fields of types 
  14:      other than float:
  15:         let get = type_float_field (if cond then "x" else "y")
  16:    - a list of records/objects/tuples can be read safely from CSV files with
  17:      a header, even if the columns are in any order and if unknown columns
  18:      are present.
  19:    - if the CSV file has no header, the columns are assumed to be in the order
  20:      of the type definition. Additional columns are ignored.
  21:    - plain English names can be given to columns labels, so that the CSV
  22:      files are ready for being manipulated in your favorite spreadsheet 
  23:      or plotting program.
  24:    - conversion of polymorphic variants without argument to and from strings
  25:      is fully automatic
  26: 
  27:    Below (file doc.ml) is a sample of code using the syntax extension.
  28:    doc.mli shows all the type definitions, submodules
  29:    and functions that are created. 
  30:    doc.ppo is the same code, after expansion by camlp4
  31:    into regular OCaml.
  32: 
  33: 
  34:    Compile with:
  35:    ocamlfind ocamlopt -c yourprogram.ml -syntax camlp4o -package col
  36: *)
  37: 
  38: 
  39: (* We define a custom type that we will use in record fields
  40:    (no syntax novelty here) *)
  41: module Date =
  42:   struct
  43:     type t = int * int
  44:     let compare (m1, y1) (m2, y2) =
  45:       let c = compare y1 y2 in if c <> 0 then c else compare m1 m2
  46:     let of_string s = Scanf.sscanf s "%i-%i" (fun m y -> m, y)
  47:     let to_string (m, y) = Printf.sprintf "%02i-%i" m y
  48:   end
  49: 
  50: (* A special syntax for defining a module which has the same structure
  51:    as the Date module above. See doc.mli.
  52:    It defines a "compare" function which uses the order in which
  53:    the tags appear in the type declaration. *)
  54: type fruit = [ `Apple | `Orange | `Banana | `Passion ]
  55: module Fruit =
  56:   struct
  57:     type t = fruit
  58:     exception Bad_format
  59:     let of_string =
  60:       function
  61:         "Apple" -> `Apple
  62:       | "Orange" -> `Orange
  63:       | "Banana" -> `Banana
  64:       | "Passion fruit" -> `Passion
  65:       | _ -> raise Bad_format
  66:     let to_string =
  67:       function
  68:         `Apple -> "Apple"
  69:       | `Orange -> "Orange"
  70:       | `Banana -> "Banana"
  71:       | `Passion -> "Passion fruit"
  72:     let of_int =
  73:       function
  74:         0 -> `Apple
  75:       | 1 -> `Orange
  76:       | 2 -> `Banana
  77:       | 3 -> `Passion
  78:       | _ -> raise Bad_format
  79:     let to_int =
  80:       function
  81:         `Apple -> 0
  82:       | `Orange -> 1
  83:       | `Banana -> 2
  84:       | `Passion -> 3
  85:     let compare a b = Pervasives.compare (to_int a) (to_int b)
  86:   end
  87: 
  88: (* The main syntax extension: it defines a record type of the same name,
  89:    plus the equivalent tuple and object types, and functions to manipulate
  90:    them. See doc.mli for the interface
  91:    and doc.ppo for the expanded OCaml code. *)
  92: type example =
  93:   { alpha : string;
  94:     bravo : string;
  95:     charlie : string;
  96:     delta : string;
  97:     echo : string;
  98:     foxtrot : int;
  99:     golf : int option;
 100:     hotel : int option;
 101:     india : float;
 102:     juliet : float option;
 103:     kilo : bool;
 104:     lima : bool option;
 105:     mike : Date.t;
 106:     november : Date.t option;
 107:     oscar : [ `Apple | `Orange ];
 108:     papa : [ `Apple | `Banana ];
 109:     quebec : Fruit.t;
 110:     mutable romeo : int }
 111: module Example =
 112:   struct
 113:     let create
 114:       ~alpha ~bravo ?(charlie = "empty") ~delta ?(echo = "nothing") ~foxtrot
 115:         ~golf ?(hotel = Some 123) ~india ~juliet ~kilo ~lima ~mike
 116:         ?(november = None) ~oscar ?(papa = `Banana) ?(quebec = `Passion)
 117:         ~romeo () =
 118:       {alpha = alpha; bravo = bravo; charlie = charlie; delta = delta;
 119:        echo = echo; foxtrot = foxtrot; golf = golf; hotel = hotel;
 120:        india = india; juliet = juliet; kilo = kilo; lima = lima; mike = mike;
 121:        november = november; oscar = oscar; papa = papa; quebec = quebec;
 122:        romeo = romeo}
 123:     let create_tuple
 124:       ~alpha
 125:         ~bravo
 126:         ?(charlie = "empty")
 127:         ~delta
 128:         ?(echo = "nothing")
 129:         ~foxtrot
 130:         ~golf
 131:         ?(hotel = Some 123)
 132:         ~india
 133:         ~juliet
 134:         ~kilo
 135:         ~lima
 136:         ~mike
 137:         ?(november = None)
 138:         ~oscar
 139:         ?(papa = `Banana)
 140:         ?(quebec = `Passion)
 141:         ~romeo
 142:         () :
 143:       string * string * string * string * string * int * int option *
 144:         int option * float * float option * bool * bool option * Date.t *
 145:         Date.t option * [ `Apple | `Orange ] * [ `Apple | `Banana ] *
 146:         Fruit.t * int =
 147:       alpha, bravo, charlie, delta, echo, foxtrot, golf, hotel, india, juliet,
 148:       kilo, lima, mike, november, oscar, papa, quebec, romeo
 149:     class
 150:       obj
 151:       ~alpha
 152:       ~bravo
 153:       ?(charlie = "empty")
 154:       ~delta
 155:       ?(echo = "nothing")
 156:       ~foxtrot
 157:       ~golf
 158:       ?(hotel = Some 123)
 159:       ~india
 160:       ~juliet
 161:       ~kilo
 162:       ~lima
 163:       ~mike
 164:       ?(november = None)
 165:       ~oscar
 166:       ?(papa = `Banana)
 167:       ?(quebec = `Passion)
 168:       ~romeo
 169:       ()
 170:       =
 171:       object
 172:         val alpha = (alpha : string) method alpha = alpha
 173:         val bravo = (bravo : string) method bravo = bravo
 174:         val charlie = (charlie : string) method charlie = charlie
 175:         val delta = (delta : string) method delta = delta
 176:         val echo = (echo : string) method echo = echo
 177:         val foxtrot = (foxtrot : int) method foxtrot = foxtrot
 178:         val golf = (golf : int option) method golf = golf
 179:         val hotel = (hotel : int option) method hotel = hotel
 180:         val india = (india : float) method india = india
 181:         val juliet = (juliet : float option) method juliet = juliet
 182:         val kilo = (kilo : bool) method kilo = kilo
 183:         val lima = (lima : bool option) method lima = lima
 184:         val mike = (mike : Date.t) method mike = mike
 185:         val november = (november : Date.t option) method november = november
 186:         val oscar = (oscar : [ `Apple | `Orange ]) method oscar = oscar
 187:         val papa = (papa : [ `Apple | `Banana ]) method papa = papa
 188:         val quebec = (quebec : Fruit.t) method quebec = quebec
 189:         val mutable romeo = (romeo : int) method romeo = romeo
 190:         method set_romeo x = romeo <- x
 191:       end
 192:     exception Bad_format
 193:     let alpha_of_string (s : string) = s
 194:     and alpha_to_string (s : string) = s
 195:     and bravo_of_string (s : string) = s
 196:     and bravo_to_string (s : string) = s
 197:     and charlie_of_string (s : string) = s
 198:     and charlie_to_string (s : string) = s
 199:     and delta_of_string (s : string) = s
 200:     and delta_to_string (s : string) = s
 201:     and echo_of_string (s : string) = s
 202:     and echo_to_string (s : string) = s
 203:     and foxtrot_of_string = Run_col.Run_col_main.int_of_string Bad_format
 204:     and foxtrot_to_string = string_of_int
 205:     and golf_of_string =
 206:       Run_col.Run_col_main.any_option_of_string
 207:         (Run_col.Run_col_main.int_of_string Bad_format)
 208:     and golf_to_string =
 209:       Run_col.Run_col_main.string_of_any_option string_of_int
 210:     and hotel_of_string =
 211:       Run_col.Run_col_main.any_option_of_string
 212:         (Run_col.Run_col_main.int_of_string Bad_format)
 213:     and hotel_to_string =
 214:       Run_col.Run_col_main.string_of_any_option string_of_int
 215:     and india_of_string = Run_col.Run_col_main.float_of_string Bad_format
 216:     and india_to_string = string_of_float
 217:     and juliet_of_string =
 218:       Run_col.Run_col_main.any_option_of_string
 219:         (Run_col.Run_col_main.float_of_string Bad_format)
 220:     and juliet_to_string =
 221:       Run_col.Run_col_main.string_of_any_option string_of_float
 222:     and kilo_of_string = Run_col.Run_col_main.bool_of_string Bad_format
 223:     and kilo_to_string = string_of_bool
 224:     and lima_of_string =
 225:       Run_col.Run_col_main.any_option_of_string
 226:         (Run_col.Run_col_main.bool_of_string Bad_format)
 227:     and lima_to_string =
 228:       Run_col.Run_col_main.string_of_any_option string_of_bool
 229:     and mike_of_string = Date.of_string
 230:     and mike_to_string = Date.to_string
 231:     and november_of_string =
 232:       Run_col.Run_col_main.any_option_of_string Date.of_string
 233:     and november_to_string =
 234:       Run_col.Run_col_main.string_of_any_option Date.to_string
 235:     and oscar_of_string =
 236:       function
 237:         "Apple" -> `Apple
 238:       | "Orange" -> `Orange
 239:       | _ -> raise Bad_format
 240:     and oscar_to_string =
 241:       function
 242:         `Apple -> "Apple"
 243:       | `Orange -> "Orange"
 244:     and papa_of_string =
 245:       function
 246:         "Apple" -> `Apple
 247:       | "Banana" -> `Banana
 248:       | _ -> raise Bad_format
 249:     and papa_to_string =
 250:       function
 251:         `Apple -> "Apple"
 252:       | `Banana -> "Banana"
 253:     and quebec_of_string = Fruit.of_string
 254:     and quebec_to_string = Fruit.to_string
 255:     and romeo_of_string = Run_col.Run_col_main.int_of_string Bad_format
 256:     and romeo_to_string = string_of_int
 257:     type t = example
 258:     module Index =
 259:       struct
 260:         let alpha = 0
 261:         let bravo = 1
 262:         let charlie = 2
 263:         let delta = 3
 264:         let echo = 4
 265:         let foxtrot = 5
 266:         let golf = 6
 267:         let hotel = 7
 268:         let india = 8
 269:         let juliet = 9
 270:         let kilo = 10
 271:         let lima = 11
 272:         let mike = 12
 273:         let november = 13
 274:         let oscar = 14
 275:         let papa = 15
 276:         let quebec = 16
 277:         let romeo = 17
 278:       end
 279:     module Compare =
 280:       struct
 281:         let alpha = String.compare
 282:         let bravo = String.compare
 283:         let charlie = String.compare
 284:         let delta = String.compare
 285:         let echo = String.compare
 286:         let foxtrot = Pervasives.compare
 287:         let golf = Run_col.Run_col_main.compare_opt Pervasives.compare
 288:         let hotel = Run_col.Run_col_main.compare_opt Pervasives.compare
 289:         let india = Pervasives.compare
 290:         let juliet = Run_col.Run_col_main.compare_opt Pervasives.compare
 291:         let kilo = Pervasives.compare
 292:         let lima = Run_col.Run_col_main.compare_opt Pervasives.compare
 293:         let mike = Date.compare
 294:         let november = Run_col.Run_col_main.compare_opt Date.compare
 295:         let oscar a b =
 296:           Pervasives.compare
 297:             ((function
 298:                 `Apple -> 0
 299:               | `Orange -> 1)
 300:                a)
 301:             ((function
 302:                 `Apple -> 0
 303:               | `Orange -> 1)
 304:                b)
 305:         let papa a b =
 306:           Pervasives.compare
 307:             ((function
 308:                 `Apple -> 0
 309:               | `Banana -> 1)
 310:                a)
 311:             ((function
 312:                 `Apple -> 0
 313:               | `Banana -> 1)
 314:                b)
 315:         let quebec = Fruit.compare
 316:         let romeo = Pervasives.compare
 317:       end
 318:     let fields =
 319:       [| "alpha"; "bravo"; "charlie"; "delta"; "echo"; "foxtrot"; "golf";
 320:          "hotel"; "india"; "juliet"; "kilo"; "lima"; "mike"; "november";
 321:          "oscar"; "papa"; "quebec"; "romeo" |]
 322:     let labels =
 323:       [| "alpha"; "Bravo!"; "charlie"; "delta"; "echo echo"; "foxtrot";
 324:          "golf"; "hotel"; "india"; "juliet"; "kilo"; "lima"; "date (mm-yyyy)";
 325:          "november"; "oscar"; "papa"; "quebec"; "romeo" |]
 326:     let of_array a =
 327:       {alpha = a.(0); bravo = a.(1); charlie = a.(2); delta = a.(3);
 328:        echo = a.(4); foxtrot = foxtrot_of_string a.(5);
 329:        golf = golf_of_string a.(6); hotel = hotel_of_string a.(7);
 330:        india = india_of_string a.(8); juliet = juliet_of_string a.(9);
 331:        kilo = kilo_of_string a.(10); lima = lima_of_string a.(11);
 332:        mike = mike_of_string a.(12); november = november_of_string a.(13);
 333:        oscar = oscar_of_string a.(14); papa = papa_of_string a.(15);
 334:        quebec = quebec_of_string a.(16); romeo = romeo_of_string a.(17)}
 335:     let to_array r =
 336:       [| r.alpha; r.bravo; r.charlie; r.delta; r.echo;
 337:          foxtrot_to_string r.foxtrot; golf_to_string r.golf;
 338:          hotel_to_string r.hotel; india_to_string r.india;
 339:          juliet_to_string r.juliet; kilo_to_string r.kilo;
 340:          lima_to_string r.lima; mike_to_string r.mike;
 341:          november_to_string r.november; oscar_to_string r.oscar;
 342:          papa_to_string r.papa; quebec_to_string r.quebec;
 343:          romeo_to_string r.romeo |]
 344:     exception Invalid_field of string
 345:     exception Invalid_label of string
 346:     let type_string_field =
 347:       function
 348:         "alpha" -> (fun (r : t) -> r.alpha)
 349:       | "bravo" -> (fun (r : t) -> r.bravo)
 350:       | "charlie" -> (fun (r : t) -> r.charlie)
 351:       | "delta" -> (fun (r : t) -> r.delta)
 352:       | "echo" -> (fun (r : t) -> r.echo)
 353:       | s -> raise (Invalid_field s)
 354:     let type_string_label =
 355:       function
 356:         "alpha" -> (fun (r : t) -> r.alpha)
 357:       | "Bravo!" -> (fun (r : t) -> r.bravo)
 358:       | "charlie" -> (fun (r : t) -> r.charlie)
 359:       | "delta" -> (fun (r : t) -> r.delta)
 360:       | "echo echo" -> (fun (r : t) -> r.echo)
 361:       | s -> raise (Invalid_label s)
 362:     let type_float_field =
 363:       function
 364:         "india" -> (fun (r : t) -> r.india)
 365:       | s -> raise (Invalid_field s)
 366:     let type_float_label =
 367:       function
 368:         "india" -> (fun (r : t) -> r.india)
 369:       | s -> raise (Invalid_label s)
 370:     let type_Fruit_field =
 371:       function
 372:         "quebec" -> (fun (r : t) -> r.quebec)
 373:       | s -> raise (Invalid_field s)
 374:     let type_Fruit_label =
 375:       function
 376:         "quebec" -> (fun (r : t) -> r.quebec)
 377:       | s -> raise (Invalid_label s)
 378:     let type_Date_field =
 379:       function
 380:         "mike" -> (fun (r : t) -> r.mike)
 381:       | s -> raise (Invalid_field s)
 382:     let type_Date_label =
 383:       function
 384:         "date (mm-yyyy)" -> (fun (r : t) -> r.mike)
 385:       | s -> raise (Invalid_label s)
 386:     let type_Date_option_field =
 387:       function
 388:         "november" -> (fun (r : t) -> r.november)
 389:       | s -> raise (Invalid_field s)
 390:     let type_Date_option_label =
 391:       function
 392:         "november" -> (fun (r : t) -> r.november)
 393:       | s -> raise (Invalid_label s)
 394:     let type_int_option_field =
 395:       function
 396:         "golf" -> (fun (r : t) -> r.golf)
 397:       | "hotel" -> (fun (r : t) -> r.hotel)
 398:       | s -> raise (Invalid_field s)
 399:     let type_int_option_label =
 400:       function
 401:         "golf" -> (fun (r : t) -> r.golf)
 402:       | "hotel" -> (fun (r : t) -> r.hotel)
 403:       | s -> raise (Invalid_label s)
 404:     let type_float_option_field =
 405:       function
 406:         "juliet" -> (fun (r : t) -> r.juliet)
 407:       | s -> raise (Invalid_field s)
 408:     let type_float_option_label =
 409:       function
 410:         "juliet" -> (fun (r : t) -> r.juliet)
 411:       | s -> raise (Invalid_label s)
 412:     let type_bool_option_field =
 413:       function
 414:         "lima" -> (fun (r : t) -> r.lima)
 415:       | s -> raise (Invalid_field s)
 416:     let type_bool_option_label =
 417:       function
 418:         "lima" -> (fun (r : t) -> r.lima)
 419:       | s -> raise (Invalid_label s)
 420:     let type_bool_field =
 421:       function
 422:         "kilo" -> (fun (r : t) -> r.kilo)
 423:       | s -> raise (Invalid_field s)
 424:     let type_bool_label =
 425:       function
 426:         "kilo" -> (fun (r : t) -> r.kilo)
 427:       | s -> raise (Invalid_label s)
 428:     let type_int_field =
 429:       function
 430:         "foxtrot" -> (fun (r : t) -> r.foxtrot)
 431:       | "romeo" -> (fun (r : t) -> r.romeo)
 432:       | s -> raise (Invalid_field s)
 433:     let type_int_label =
 434:       function
 435:         "foxtrot" -> (fun (r : t) -> r.foxtrot)
 436:       | "romeo" -> (fun (r : t) -> r.romeo)
 437:       | s -> raise (Invalid_label s)
 438:     let load_csv_rows =
 439:       fun ?strict ->
 440:         fun ?noheader file f ->
 441:           Run_col.Run_col_main.input_csv_file ?strict ?noheader labels
 442:             of_array file f
 443:     let load_csv =
 444:       fun ?strict ->
 445:         fun ?noheader ->
 446:           fun ?rev file ->
 447:             Run_col.Run_col_main.input_csv_list_file ?strict ?noheader ?rev
 448:               labels of_array file
 449:     let open_out_csv =
 450:       fun ?sep ->
 451:         fun ?noheader file ->
 452:           Run_col.Run_col_main.open_out_csv ?sep ?noheader labels to_array
 453:             file
 454:     let save_csv_rows =
 455:       fun ?sep ->
 456:         fun ?noheader file f ->
 457:           Run_col.Run_col_main.output_csv_file ?sep ?noheader labels to_array
 458:             file f
 459:     let save_csv =
 460:       fun ?sep ->
 461:         fun ?noheader file l ->
 462:           Run_col.Run_col_main.output_csv_list_file ?sep ?noheader labels
 463:             to_array file l
 464:     let compare_fields l =
 465:       Run_col.Run_col_main.multi_compare
 466:         (List.map
 467:            (function
 468:               `Up s ->
 469:                 begin match s with
 470:                   "alpha" -> (fun a b -> Compare.alpha a.alpha b.alpha)
 471:                 | "bravo" -> (fun a b -> Compare.bravo a.bravo b.bravo)
 472:                 | "charlie" ->
 473:                     (fun a b -> Compare.charlie a.charlie b.charlie)
 474:                 | "delta" -> (fun a b -> Compare.delta a.delta b.delta)
 475:                 | "echo" -> (fun a b -> Compare.echo a.echo b.echo)
 476:                 | "foxtrot" ->
 477:                     (fun a b -> Compare.foxtrot a.foxtrot b.foxtrot)
 478:                 | "golf" -> (fun a b -> Compare.golf a.golf b.golf)
 479:                 | "hotel" -> (fun a b -> Compare.hotel a.hotel b.hotel)
 480:                 | "india" -> (fun a b -> Compare.india a.india b.india)
 481:                 | "juliet" -> (fun a b -> Compare.juliet a.juliet b.juliet)
 482:                 | "kilo" -> (fun a b -> Compare.kilo a.kilo b.kilo)
 483:                 | "lima" -> (fun a b -> Compare.lima a.lima b.lima)
 484:                 | "mike" -> (fun a b -> Compare.mike a.mike b.mike)
 485:                 | "november" ->
 486:                     (fun a b -> Compare.november a.november b.november)
 487:                 | "oscar" -> (fun a b -> Compare.oscar a.oscar b.oscar)
 488:                 | "papa" -> (fun a b -> Compare.papa a.papa b.papa)
 489:                 | "quebec" -> (fun a b -> Compare.quebec a.quebec b.quebec)
 490:                 | "romeo" -> (fun a b -> Compare.romeo a.romeo b.romeo)
 491:                 | s -> raise (Invalid_field s)
 492:                 end
 493:             | `Down s ->
 494:                 begin match s with
 495:                   "alpha" -> (fun a b -> Compare.alpha b.alpha a.alpha)
 496:                 | "bravo" -> (fun a b -> Compare.bravo b.bravo a.bravo)
 497:                 | "charlie" ->
 498:                     (fun a b -> Compare.charlie b.charlie a.charlie)
 499:                 | "delta" -> (fun a b -> Compare.delta b.delta a.delta)
 500:                 | "echo" -> (fun a b -> Compare.echo b.echo a.echo)
 501:                 | "foxtrot" ->
 502:                     (fun a b -> Compare.foxtrot b.foxtrot a.foxtrot)
 503:                 | "golf" -> (fun a b -> Compare.golf b.golf a.golf)
 504:                 | "hotel" -> (fun a b -> Compare.hotel b.hotel a.hotel)
 505:                 | "india" -> (fun a b -> Compare.india b.india a.india)
 506:                 | "juliet" -> (fun a b -> Compare.juliet b.juliet a.juliet)
 507:                 | "kilo" -> (fun a b -> Compare.kilo b.kilo a.kilo)
 508:                 | "lima" -> (fun a b -> Compare.lima b.lima a.lima)
 509:                 | "mike" -> (fun a b -> Compare.mike b.mike a.mike)
 510:                 | "november" ->
 511:                     (fun a b -> Compare.november b.november a.november)
 512:                 | "oscar" -> (fun a b -> Compare.oscar b.oscar a.oscar)
 513:                 | "papa" -> (fun a b -> Compare.papa b.papa a.papa)
 514:                 | "quebec" -> (fun a b -> Compare.quebec b.quebec a.quebec)
 515:                 | "romeo" -> (fun a b -> Compare.romeo b.romeo a.romeo)
 516:                 | s -> raise (Invalid_field s)
 517:                 end
 518:             | `Custom f -> f)
 519:            l)
 520:     let compare_labels l =
 521:       Run_col.Run_col_main.multi_compare
 522:         (List.map
 523:            (function
 524:               `Up s ->
 525:                 begin match s with
 526:                   "alpha" -> (fun a b -> Compare.alpha a.alpha b.alpha)
 527:                 | "Bravo!" -> (fun a b -> Compare.bravo a.bravo b.bravo)
 528:                 | "charlie" ->
 529:                     (fun a b -> Compare.charlie a.charlie b.charlie)
 530:                 | "delta" -> (fun a b -> Compare.delta a.delta b.delta)
 531:                 | "echo echo" -> (fun a b -> Compare.echo a.echo b.echo)
 532:                 | "foxtrot" ->
 533:                     (fun a b -> Compare.foxtrot a.foxtrot b.foxtrot)
 534:                 | "golf" -> (fun a b -> Compare.golf a.golf b.golf)
 535:                 | "hotel" -> (fun a b -> Compare.hotel a.hotel b.hotel)
 536:                 | "india" -> (fun a b -> Compare.india a.india b.india)
 537:                 | "juliet" -> (fun a b -> Compare.juliet a.juliet b.juliet)
 538:                 | "kilo" -> (fun a b -> Compare.kilo a.kilo b.kilo)
 539:                 | "lima" -> (fun a b -> Compare.lima a.lima b.lima)
 540:                 | "date (mm-yyyy)" -> (fun a b -> Compare.mike a.mike b.mike)
 541:                 | "november" ->
 542:                     (fun a b -> Compare.november a.november b.november)
 543:                 | "oscar" -> (fun a b -> Compare.oscar a.oscar b.oscar)
 544:                 | "papa" -> (fun a b -> Compare.papa a.papa b.papa)
 545:                 | "quebec" -> (fun a b -> Compare.quebec a.quebec b.quebec)
 546:                 | "romeo" -> (fun a b -> Compare.romeo a.romeo b.romeo)
 547:                 | s -> raise (Invalid_label s)
 548:                 end
 549:             | `Down s ->
 550:                 begin match s with
 551:                   "alpha" -> (fun a b -> Compare.alpha b.alpha a.alpha)
 552:                 | "Bravo!" -> (fun a b -> Compare.bravo b.bravo a.bravo)
 553:                 | "charlie" ->
 554:                     (fun a b -> Compare.charlie b.charlie a.charlie)
 555:                 | "delta" -> (fun a b -> Compare.delta b.delta a.delta)
 556:                 | "echo echo" -> (fun a b -> Compare.echo b.echo a.echo)
 557:                 | "foxtrot" ->
 558:                     (fun a b -> Compare.foxtrot b.foxtrot a.foxtrot)
 559:                 | "golf" -> (fun a b -> Compare.golf b.golf a.golf)
 560:                 | "hotel" -> (fun a b -> Compare.hotel b.hotel a.hotel)
 561:                 | "india" -> (fun a b -> Compare.india b.india a.india)
 562:                 | "juliet" -> (fun a b -> Compare.juliet b.juliet a.juliet)
 563:                 | "kilo" -> (fun a b -> Compare.kilo b.kilo a.kilo)
 564:                 | "lima" -> (fun a b -> Compare.lima b.lima a.lima)
 565:                 | "date (mm-yyyy)" -> (fun a b -> Compare.mike b.mike a.mike)
 566:                 | "november" ->
 567:                     (fun a b -> Compare.november b.november a.november)
 568:                 | "oscar" -> (fun a b -> Compare.oscar b.oscar a.oscar)
 569:                 | "papa" -> (fun a b -> Compare.papa b.papa a.papa)
 570:                 | "quebec" -> (fun a b -> Compare.quebec b.quebec a.quebec)
 571:                 | "romeo" -> (fun a b -> Compare.romeo b.romeo a.romeo)
 572:                 | s -> raise (Invalid_label s)
 573:                 end
 574:             | `Custom f -> f)
 575:            l)
 576:     module Tup =
 577:       struct
 578:         type t =
 579:           string * string * string * string * string * int * int option *
 580:             int option * float * float option * bool * bool option * Date.t *
 581:             Date.t option * [ `Apple | `Orange ] * [ `Apple | `Banana ] *
 582:             Fruit.t * int
 583:         let create = create_tuple
 584:         let of_array a =
 585:           a.(0), a.(1), a.(2), a.(3), a.(4), foxtrot_of_string a.(5),
 586:           golf_of_string a.(6), hotel_of_string a.(7), india_of_string a.(8),
 587:           juliet_of_string a.(9), kilo_of_string a.(10),
 588:           lima_of_string a.(11), mike_of_string a.(12),
 589:           november_of_string a.(13), oscar_of_string a.(14),
 590:           papa_of_string a.(15), quebec_of_string a.(16),
 591:           romeo_of_string a.(17)
 592:         let to_array
 593:           (alpha, bravo, charlie, delta, echo, foxtrot, golf, hotel, india,
 594:            juliet, kilo, lima, mike, november, oscar, papa, quebec, romeo) =
 595:           [| alpha; bravo; charlie; delta; echo; foxtrot_to_string foxtrot;
 596:              golf_to_string golf; hotel_to_string hotel;
 597:              india_to_string india; juliet_to_string juliet;
 598:              kilo_to_string kilo; lima_to_string lima; mike_to_string mike;
 599:              november_to_string november; oscar_to_string oscar;
 600:              papa_to_string papa; quebec_to_string quebec;
 601:              romeo_to_string romeo |]
 602:         let of_record r : t =
 603:           r.alpha, r.bravo, r.charlie, r.delta, r.echo, r.foxtrot, r.golf,
 604:           r.hotel, r.india, r.juliet, r.kilo, r.lima, r.mike, r.november,
 605:           r.oscar, r.papa, r.quebec, r.romeo
 606:         let to_record
 607:           (alpha, bravo, charlie, delta, echo, foxtrot, golf, hotel, india,
 608:            juliet, kilo, lima, mike, november, oscar, papa, quebec, romeo :
 609:            t) =
 610:           {alpha = alpha; bravo = bravo; charlie = charlie; delta = delta;
 611:            echo = echo; foxtrot = foxtrot; golf = golf; hotel = hotel;
 612:            india = india; juliet = juliet; kilo = kilo; lima = lima;
 613:            mike = mike; november = november; oscar = oscar; papa = papa;
 614:            quebec = quebec; romeo = romeo}
 615:         let get_alpha
 616:           (x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) =
 617:           x
 618:         and get_bravo
 619:           (_, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) =
 620:           x
 621:         and get_charlie
 622:           (_, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) =
 623:           x
 624:         and get_delta
 625:           (_, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) =
 626:           x
 627:         and get_echo
 628:           (_, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) =
 629:           x
 630:         and get_foxtrot
 631:           (_, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _ : t) =
 632:           x
 633:         and get_golf
 634:           (_, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _ : t) =
 635:           x
 636:         and get_hotel
 637:           (_, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _ : t) =
 638:           x
 639:         and get_india
 640:           (_, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _ : t) =
 641:           x
 642:         and get_juliet
 643:           (_, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _ : t) =
 644:           x
 645:         and get_kilo
 646:           (_, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _ : t) =
 647:           x
 648:         and get_lima
 649:           (_, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _ : t) =
 650:           x
 651:         and get_mike
 652:           (_, _, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _ : t) =
 653:           x
 654:         and get_november
 655:           (_, _, _, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _ : t) =
 656:           x
 657:         and get_oscar
 658:           (_, _, _, _, _, _, _, _, _, _, _, _, _, _, x, _, _, _ : t) =
 659:           x
 660:         and get_papa
 661:           (_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, x, _, _ : t) =
 662:           x
 663:         and get_quebec
 664:           (_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, x, _ : t) =
 665:           x
 666:         and get_romeo
 667:           (_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, x : t) =
 668:           x
 669:         exception Invalid_field of string
 670:         exception Invalid_label of string
 671:         let type_string_field =
 672:           function
 673:             "alpha" ->
 674:               (fun
 675:                  (x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 676:                  x)
 677:           | "bravo" ->
 678:               (fun
 679:                  (_, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 680:                  x)
 681:           | "charlie" ->
 682:               (fun
 683:                  (_, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 684:                  x)
 685:           | "delta" ->
 686:               (fun
 687:                  (_, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 688:                  x)
 689:           | "echo" ->
 690:               (fun
 691:                  (_, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 692:                  x)
 693:           | s -> raise (Invalid_field s)
 694:         let type_string_label =
 695:           function
 696:             "alpha" ->
 697:               (fun
 698:                  (x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 699:                  x)
 700:           | "Bravo!" ->
 701:               (fun
 702:                  (_, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 703:                  x)
 704:           | "charlie" ->
 705:               (fun
 706:                  (_, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 707:                  x)
 708:           | "delta" ->
 709:               (fun
 710:                  (_, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 711:                  x)
 712:           | "echo echo" ->
 713:               (fun
 714:                  (_, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 715:                  x)
 716:           | s -> raise (Invalid_label s)
 717:         let type_float_field =
 718:           function
 719:             "india" ->
 720:               (fun
 721:                  (_, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _ : t) ->
 722:                  x)
 723:           | s -> raise (Invalid_field s)
 724:         let type_float_label =
 725:           function
 726:             "india" ->
 727:               (fun
 728:                  (_, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _ : t) ->
 729:                  x)
 730:           | s -> raise (Invalid_label s)
 731:         let type_Fruit_field =
 732:           function
 733:             "quebec" ->
 734:               (fun
 735:                  (_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, x, _ : t) ->
 736:                  x)
 737:           | s -> raise (Invalid_field s)
 738:         let type_Fruit_label =
 739:           function
 740:             "quebec" ->
 741:               (fun
 742:                  (_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, x, _ : t) ->
 743:                  x)
 744:           | s -> raise (Invalid_label s)
 745:         let type_Date_field =
 746:           function
 747:             "mike" ->
 748:               (fun
 749:                  (_, _, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _ : t) ->
 750:                  x)
 751:           | s -> raise (Invalid_field s)
 752:         let type_Date_label =
 753:           function
 754:             "date (mm-yyyy)" ->
 755:               (fun
 756:                  (_, _, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _ : t) ->
 757:                  x)
 758:           | s -> raise (Invalid_label s)
 759:         let type_Date_option_field =
 760:           function
 761:             "november" ->
 762:               (fun
 763:                  (_, _, _, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _ : t) ->
 764:                  x)
 765:           | s -> raise (Invalid_field s)
 766:         let type_Date_option_label =
 767:           function
 768:             "november" ->
 769:               (fun
 770:                  (_, _, _, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _ : t) ->
 771:                  x)
 772:           | s -> raise (Invalid_label s)
 773:         let type_int_option_field =
 774:           function
 775:             "golf" ->
 776:               (fun
 777:                  (_, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 778:                  x)
 779:           | "hotel" ->
 780:               (fun
 781:                  (_, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _ : t) ->
 782:                  x)
 783:           | s -> raise (Invalid_field s)
 784:         let type_int_option_label =
 785:           function
 786:             "golf" ->
 787:               (fun
 788:                  (_, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 789:                  x)
 790:           | "hotel" ->
 791:               (fun
 792:                  (_, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _ : t) ->
 793:                  x)
 794:           | s -> raise (Invalid_label s)
 795:         let type_float_option_field =
 796:           function
 797:             "juliet" ->
 798:               (fun
 799:                  (_, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _ : t) ->
 800:                  x)
 801:           | s -> raise (Invalid_field s)
 802:         let type_float_option_label =
 803:           function
 804:             "juliet" ->
 805:               (fun
 806:                  (_, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _, _ : t) ->
 807:                  x)
 808:           | s -> raise (Invalid_label s)
 809:         let type_bool_option_field =
 810:           function
 811:             "lima" ->
 812:               (fun
 813:                  (_, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _ : t) ->
 814:                  x)
 815:           | s -> raise (Invalid_field s)
 816:         let type_bool_option_label =
 817:           function
 818:             "lima" ->
 819:               (fun
 820:                  (_, _, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _ : t) ->
 821:                  x)
 822:           | s -> raise (Invalid_label s)
 823:         let type_bool_field =
 824:           function
 825:             "kilo" ->
 826:               (fun
 827:                  (_, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _ : t) ->
 828:                  x)
 829:           | s -> raise (Invalid_field s)
 830:         let type_bool_label =
 831:           function
 832:             "kilo" ->
 833:               (fun
 834:                  (_, _, _, _, _, _, _, _, _, _, x, _, _, _, _, _, _, _ : t) ->
 835:                  x)
 836:           | s -> raise (Invalid_label s)
 837:         let type_int_field =
 838:           function
 839:             "foxtrot" ->
 840:               (fun
 841:                  (_, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 842:                  x)
 843:           | "romeo" ->
 844:               (fun
 845:                  (_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, x : t) ->
 846:                  x)
 847:           | s -> raise (Invalid_field s)
 848:         let type_int_label =
 849:           function
 850:             "foxtrot" ->
 851:               (fun
 852:                  (_, _, _, _, _, x, _, _, _, _, _, _, _, _, _, _, _, _ : t) ->
 853:                  x)
 854:           | "romeo" ->
 855:               (fun
 856:                  (_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, x : t) ->
 857:                  x)
 858:           | s -> raise (Invalid_label s)
 859:         let load_csv_rows =
 860:           fun ?strict ->
 861:             fun ?noheader file f ->
 862:               Run_col.Run_col_main.input_csv_file ?strict ?noheader labels
 863:                 of_array file f
 864:         let load_csv =
 865:           fun ?strict ->
 866:             fun ?noheader ->
 867:               fun ?rev file ->
 868:                 Run_col.Run_col_main.input_csv_list_file ?strict ?noheader
 869:                   ?rev labels of_array file
 870:         let open_out_csv =
 871:           fun ?sep ->
 872:             fun ?noheader file ->
 873:               Run_col.Run_col_main.open_out_csv ?sep ?noheader labels to_array
 874:                 file
 875:         let save_csv_rows =
 876:           fun ?sep ->
 877:             fun ?noheader file f ->
 878:               Run_col.Run_col_main.output_csv_file ?sep ?noheader labels
 879:                 to_array file f
 880:         let save_csv =
 881:           fun ?sep ->
 882:             fun ?noheader file l ->
 883:               Run_col.Run_col_main.output_csv_list_file ?sep ?noheader labels
 884:                 to_array file l
 885:         let compare_fields l =
 886:           Run_col.Run_col_main.multi_compare
 887:             (List.map
 888:                (function
 889:                   `Up s ->
 890:                     begin match s with
 891:                       "alpha" ->
 892:                         (fun a b -> Compare.alpha (get_alpha a) (get_alpha b))
 893:                     | "bravo" ->
 894:                         (fun a b -> Compare.bravo (get_bravo a) (get_bravo b))
 895:                     | "charlie" ->
 896:                         (fun a b ->
 897:                            Compare.charlie (get_charlie a) (get_charlie b))
 898:                     | "delta" ->
 899:                         (fun a b -> Compare.delta (get_delta a) (get_delta b))
 900:                     | "echo" ->
 901:                         (fun a b -> Compare.echo (get_echo a) (get_echo b))
 902:                     | "foxtrot" ->
 903:                         (fun a b ->
 904:                            Compare.foxtrot (get_foxtrot a) (get_foxtrot b))
 905:                     | "golf" ->
 906:                         (fun a b -> Compare.golf (get_golf a) (get_golf b))
 907:                     | "hotel" ->
 908:                         (fun a b -> Compare.hotel (get_hotel a) (get_hotel b))
 909:                     | "india" ->
 910:                         (fun a b -> Compare.india (get_india a) (get_india b))
 911:                     | "juliet" ->
 912:                         (fun a b ->
 913:                            Compare.juliet (get_juliet a) (get_juliet b))
 914:                     | "kilo" ->
 915:                         (fun a b -> Compare.kilo (get_kilo a) (get_kilo b))
 916:                     | "lima" ->
 917:                         (fun a b -> Compare.lima (get_lima a) (get_lima b))
 918:                     | "mike" ->
 919:                         (fun a b -> Compare.mike (get_mike a) (get_mike b))
 920:                     | "november" ->
 921:                         (fun a b ->
 922:                            Compare.november (get_november a) (get_november b))
 923:                     | "oscar" ->
 924:                         (fun a b -> Compare.oscar (get_oscar a) (get_oscar b))
 925:                     | "papa" ->
 926:                         (fun a b -> Compare.papa (get_papa a) (get_papa b))
 927:                     | "quebec" ->
 928:                         (fun a b ->
 929:                            Compare.quebec (get_quebec a) (get_quebec b))
 930:                     | "romeo" ->
 931:                         (fun a b -> Compare.romeo (get_romeo a) (get_romeo b))
 932:                     | s -> raise (Invalid_field s)
 933:                     end
 934:                 | `Down s ->
 935:                     begin match s with
 936:                       "alpha" ->
 937:                         (fun a b -> Compare.alpha (get_alpha b) (get_alpha a))
 938:                     | "bravo" ->
 939:                         (fun a b -> Compare.bravo (get_bravo b) (get_bravo a))
 940:                     | "charlie" ->
 941:                         (fun a b ->
 942:                            Compare.charlie (get_charlie b) (get_charlie a))
 943:                     | "delta" ->
 944:                         (fun a b -> Compare.delta (get_delta b) (get_delta a))
 945:                     | "echo" ->
 946:                         (fun a b -> Compare.echo (get_echo b) (get_echo a))
 947:                     | "foxtrot" ->
 948:                         (fun a b ->
 949:                            Compare.foxtrot (get_foxtrot b) (get_foxtrot a))
 950:                     | "golf" ->
 951:                         (fun a b -> Compare.golf (get_golf b) (get_golf a))
 952:                     | "hotel" ->
 953:                         (fun a b -> Compare.hotel (get_hotel b) (get_hotel a))
 954:                     | "india" ->
 955:                         (fun a b -> Compare.india (get_india b) (get_india a))
 956:                     | "juliet" ->
 957:                         (fun a b ->
 958:                            Compare.juliet (get_juliet b) (get_juliet a))
 959:                     | "kilo" ->
 960:                         (fun a b -> Compare.kilo (get_kilo b) (get_kilo a))
 961:                     | "lima" ->
 962:                         (fun a b -> Compare.lima (get_lima b) (get_lima a))
 963:                     | "mike" ->
 964:                         (fun a b -> Compare.mike (get_mike b) (get_mike a))
 965:                     | "november" ->
 966:                         (fun a b ->
 967:                            Compare.november (get_november b) (get_november a))
 968:                     | "oscar" ->
 969:                         (fun a b -> Compare.oscar (get_oscar b) (get_oscar a))
 970:                     | "papa" ->
 971:                         (fun a b -> Compare.papa (get_papa b) (get_papa a))
 972:                     | "quebec" ->
 973:                         (fun a b ->
 974:                            Compare.quebec (get_quebec b) (get_quebec a))
 975:                     | "romeo" ->
 976:                         (fun a b -> Compare.romeo (get_romeo b) (get_romeo a))
 977:                     | s -> raise (Invalid_field s)
 978:                     end
 979:                 | `Custom f -> f)
 980:                l)
 981:         let compare_labels l =
 982:           Run_col.Run_col_main.multi_compare
 983:             (List.map
 984:                (function
 985:                   `Up s ->
 986:                     begin match s with
 987:                       "alpha" ->
 988:                         (fun a b -> Compare.alpha (get_alpha a) (get_alpha b))
 989:                     | "Bravo!" ->
 990:                         (fun a b -> Compare.bravo (get_bravo a) (get_bravo b))
 991:                     | "charlie" ->
 992:                         (fun a b ->
 993:                            Compare.charlie (get_charlie a) (get_charlie b))
 994:                     | "delta" ->
 995:                         (fun a b -> Compare.delta (get_delta a) (get_delta b))
 996:                     | "echo echo" ->
 997:                         (fun a b -> Compare.echo (get_echo a) (get_echo b))
 998:                     | "foxtrot" ->
 999:                         (fun a b ->
1000:                            Compare.foxtrot (get_foxtrot a) (get_foxtrot b))
1001:                     | "golf" ->
1002:                         (fun a b -> Compare.golf (get_golf a) (get_golf b))
1003:                     | "hotel" ->
1004:                         (fun a b -> Compare.hotel (get_hotel a) (get_hotel b))
1005:                     | "india" ->
1006:                         (fun a b -> Compare.india (get_india a) (get_india b))
1007:                     | "juliet" ->
1008:                         (fun a b ->
1009:                            Compare.juliet (get_juliet a) (get_juliet b))
1010:                     | "kilo" ->
1011:                         (fun a b -> Compare.kilo (get_kilo a) (get_kilo b))
1012:                     | "lima" ->
1013:                         (fun a b -> Compare.lima (get_lima a) (get_lima b))
1014:                     | "date (mm-yyyy)" ->
1015:                         (fun a b -> Compare.mike (get_mike a) (get_mike b))
1016:                     | "november" ->
1017:                         (fun a b ->
1018:                            Compare.november (get_november a) (get_november b))
1019:                     | "oscar" ->
1020:                         (fun a b -> Compare.oscar (get_oscar a) (get_oscar b))
1021:                     | "papa" ->
1022:                         (fun a b -> Compare.papa (get_papa a) (get_papa b))
1023:                     | "quebec" ->
1024:                         (fun a b ->
1025:                            Compare.quebec (get_quebec a) (get_quebec b))
1026:                     | "romeo" ->
1027:                         (fun a b -> Compare.romeo (get_romeo a) (get_romeo b))
1028:                     | s -> raise (Invalid_label s)
1029:                     end
1030:                 | `Down s ->
1031:                     begin match s with
1032:                       "alpha" ->
1033:                         (fun a b -> Compare.alpha (get_alpha b) (get_alpha a))
1034:                     | "Bravo!" ->
1035:                         (fun a b -> Compare.bravo (get_bravo b) (get_bravo a))
1036:                     | "charlie" ->
1037:                         (fun a b ->
1038:                            Compare.charlie (get_charlie b) (get_charlie a))
1039:                     | "delta" ->
1040:                         (fun a b -> Compare.delta (get_delta b) (get_delta a))
1041:                     | "echo echo" ->
1042:                         (fun a b -> Compare.echo (get_echo b) (get_echo a))
1043:                     | "foxtrot" ->
1044:                         (fun a b ->
1045:                            Compare.foxtrot (get_foxtrot b) (get_foxtrot a))
1046:                     | "golf" ->
1047:                         (fun a b -> Compare.golf (get_golf b) (get_golf a))
1048:                     | "hotel" ->
1049:                         (fun a b -> Compare.hotel (get_hotel b) (get_hotel a))
1050:                     | "india" ->
1051:                         (fun a b -> Compare.india (get_india b) (get_india a))
1052:                     | "juliet" ->
1053:                         (fun a b ->
1054:                            Compare.juliet (get_juliet b) (get_juliet a))
1055:                     | "kilo" ->
1056:                         (fun a b -> Compare.kilo (get_kilo b) (get_kilo a))
1057:                     | "lima" ->
1058:                         (fun a b -> Compare.lima (get_lima b) (get_lima a))
1059:                     | "date (mm-yyyy)" ->
1060:                         (fun a b -> Compare.mike (get_mike b) (get_mike a))
1061:                     | "november" ->
1062:                         (fun a b ->
1063:                            Compare.november (get_november b) (get_november a))
1064:                     | "oscar" ->
1065:                         (fun a b -> Compare.oscar (get_oscar b) (get_oscar a))
1066:                     | "papa" ->
1067:                         (fun a b -> Compare.papa (get_papa b) (get_papa a))
1068:                     | "quebec" ->
1069:                         (fun a b ->
1070:                            Compare.quebec (get_quebec b) (get_quebec a))
1071:                     | "romeo" ->
1072:                         (fun a b -> Compare.romeo (get_romeo b) (get_romeo a))
1073:                     | s -> raise (Invalid_label s)
1074:                     end
1075:                 | `Custom f -> f)
1076:                l)
1077:       end
1078:     module OO =
1079:       struct
1080:         class t = obj
1081:         let create = new t
1082:         let of_array a =
1083:           new t ~alpha:(a.(0)) ~bravo:(a.(1)) ~charlie:(a.(2)) ~delta:(a.(3))
1084:             ~echo:(a.(4)) ~foxtrot:(foxtrot_of_string a.(5))
1085:             ~golf:(golf_of_string a.(6)) ~hotel:(hotel_of_string a.(7))
1086:             ~india:(india_of_string a.(8)) ~juliet:(juliet_of_string a.(9))
1087:             ~kilo:(kilo_of_string a.(10)) ~lima:(lima_of_string a.(11))
1088:             ~mike:(mike_of_string a.(12))
1089:             ~november:(november_of_string a.(13))
1090:             ~oscar:(oscar_of_string a.(14)) ~papa:(papa_of_string a.(15))
1091:             ~quebec:(quebec_of_string a.(16)) ~romeo:(romeo_of_string a.(17))
1092:             ()
1093:         let to_array o =
1094:           [| o#alpha; o#bravo; o#charlie; o#delta; o#echo;
1095:              foxtrot_to_string o#foxtrot; golf_to_string o#golf;
1096:              hotel_to_string o#hotel; india_to_string o#india;
1097:              juliet_to_string o#juliet; kilo_to_string o#kilo;
1098:              lima_to_string o#lima; mike_to_string o#mike;
1099:              november_to_string o#november; oscar_to_string o#oscar;
1100:              papa_to_string o#papa; quebec_to_string o#quebec;
1101:              romeo_to_string o#romeo |]
1102:         let of_record r =
1103:           new t ~alpha:(r.alpha) ~bravo:(r.bravo) ~charlie:(r.charlie)
1104:             ~delta:(r.delta) ~echo:(r.echo) ~foxtrot:(r.foxtrot)
1105:             ~golf:(r.golf) ~hotel:(r.hotel) ~india:(r.india)
1106:             ~juliet:(r.juliet) ~kilo:(r.kilo) ~lima:(r.lima) ~mike:(r.mike)
1107:             ~november:(r.november) ~oscar:(r.oscar) ~papa:(r.papa)
1108:             ~quebec:(r.quebec) ~romeo:(r.romeo) ()
1109:         let to_record o =
1110:           {alpha = o#alpha; bravo = o#bravo; charlie = o#charlie;
1111:            delta = o#delta; echo = o#echo; foxtrot = o#foxtrot; golf = o#golf;
1112:            hotel = o#hotel; india = o#india; juliet = o#juliet; kilo = o#kilo;
1113:            lima = o#lima; mike = o#mike; november = o#november;
1114:            oscar = o#oscar; papa = o#papa; quebec = o#quebec; romeo = o#romeo}
1115:         exception Invalid_field of string
1116:         exception Invalid_label of string
1117:         let type_string_field =
1118:           function
1119:             "alpha" -> (fun (o : t) -> o#alpha)
1120:           | "bravo" -> (fun (o : t) -> o#bravo)
1121:           | "charlie" -> (fun (o : t) -> o#charlie)
1122:           | "delta" -> (fun (o : t) -> o#delta)
1123:           | "echo" -> (fun (o : t) -> o#echo)
1124:           | s -> raise (Invalid_field s)
1125:         let type_string_label =
1126:           function
1127:             "alpha" -> (fun (o : t) -> o#alpha)
1128:           | "Bravo!" -> (fun (o : t) -> o#bravo)
1129:           | "charlie" -> (fun (o : t) -> o#charlie)
1130:           | "delta" -> (fun (o : t) -> o#delta)
1131:           | "echo echo" -> (fun (o : t) -> o#echo)
1132:           | s -> raise (Invalid_label s)
1133:         let type_float_field =
1134:           function
1135:             "india" -> (fun (o : t) -> o#india)
1136:           | s -> raise (Invalid_field s)
1137:         let type_float_label =
1138:           function
1139:             "india" -> (fun (o : t) -> o#india)
1140:           | s -> raise (Invalid_label s)
1141:         let type_Fruit_field =
1142:           function
1143:             "quebec" -> (fun (o : t) -> o#quebec)
1144:           | s -> raise (Invalid_field s)
1145:         let type_Fruit_label =
1146:           function
1147:             "quebec" -> (fun (o : t) -> o#quebec)
1148:           | s -> raise (Invalid_label s)
1149:         let type_Date_field =
1150:           function
1151:             "mike" -> (fun (o : t) -> o#mike)
1152:           | s -> raise (Invalid_field s)
1153:         let type_Date_label =
1154:           function
1155:             "date (mm-yyyy)" -> (fun (o : t) -> o#mike)
1156:           | s -> raise (Invalid_label s)
1157:         let type_Date_option_field =
1158:           function
1159:             "november" -> (fun (o : t) -> o#november)
1160:           | s -> raise (Invalid_field s)
1161:         let type_Date_option_label =
1162:           function
1163:             "november" -> (fun (o : t) -> o#november)
1164:           | s -> raise (Invalid_label s)
1165:         let type_int_option_field =
1166:           function
1167:             "golf" -> (fun (o : t) -> o#golf)
1168:           | "hotel" -> (fun (o : t) -> o#hotel)
1169:           | s -> raise (Invalid_field s)
1170:         let type_int_option_label =
1171:           function
1172:             "golf" -> (fun (o : t) -> o#golf)
1173:           | "hotel" -> (fun (o : t) -> o#hotel)
1174:           | s -> raise (Invalid_label s)
1175:         let type_float_option_field =
1176:           function
1177:             "juliet" -> (fun (o : t) -> o#juliet)
1178:           | s -> raise (Invalid_field s)
1179:         let type_float_option_label =
1180:           function
1181:             "juliet" -> (fun (o : t) -> o#juliet)
1182:           | s -> raise (Invalid_label s)
1183:         let type_bool_option_field =
1184:           function
1185:             "lima" -> (fun (o : t) -> o#lima)
1186:           | s -> raise (Invalid_field s)
1187:         let type_bool_option_label =
1188:           function
1189:             "lima" -> (fun (o : t) -> o#lima)
1190:           | s -> raise (Invalid_label s)
1191:         let type_bool_field =
1192:           function
1193:             "kilo" -> (fun (o : t) -> o#kilo)
1194:           | s -> raise (Invalid_field s)
1195:         let type_bool_label =
1196:           function
1197:             "kilo" -> (fun (o : t) -> o#kilo)
1198:           | s -> raise (Invalid_label s)
1199:         let type_int_field =
1200:           function
1201:             "foxtrot" -> (fun (o : t) -> o#foxtrot)
1202:           | "romeo" -> (fun (o : t) -> o#romeo)
1203:           | s -> raise (Invalid_field s)
1204:         let type_int_label =
1205:           function
1206:             "foxtrot" -> (fun (o : t) -> o#foxtrot)
1207:           | "romeo" -> (fun (o : t) -> o#romeo)
1208:           | s -> raise (Invalid_label s)
1209:         let load_csv_rows =
1210:           fun ?strict ->
1211:             fun ?noheader file f ->
1212:               Run_col.Run_col_main.input_csv_file ?strict ?noheader labels
1213:                 of_array file f
1214:         let load_csv =
1215:           fun ?strict ->
1216:             fun ?noheader ->
1217:               fun ?rev file ->
1218:                 Run_col.Run_col_main.input_csv_list_file ?strict ?noheader
1219:                   ?rev labels of_array file
1220:         let open_out_csv =
1221:           fun ?sep ->
1222:             fun ?noheader file ->
1223:               Run_col.Run_col_main.open_out_csv ?sep ?noheader labels to_array
1224:                 file
1225:         let save_csv_rows =
1226:           fun ?sep ->
1227:             fun ?noheader file f ->
1228:               Run_col.Run_col_main.output_csv_file ?sep ?noheader labels
1229:                 to_array file f
1230:         let save_csv =
1231:           fun ?sep ->
1232:             fun ?noheader file l ->
1233:               Run_col.Run_col_main.output_csv_list_file ?sep ?noheader labels
1234:                 to_array file l
1235:         let compare_fields l =
1236:           Run_col.Run_col_main.multi_compare
1237:             (List.map
1238:                (function
1239:                   `Up s ->
1240:                     begin match s with
1241:                       "alpha" -> (fun a b -> Compare.alpha a#alpha b#alpha)
1242:                     | "bravo" -> (fun a b -> Compare.bravo a#bravo b#bravo)
1243:                     | "charlie" ->
1244:                         (fun a b -> Compare.charlie a#charlie b#charlie)
1245:                     | "delta" -> (fun a b -> Compare.delta a#delta b#delta)
1246:                     | "echo" -> (fun a b -> Compare.echo a#echo b#echo)
1247:                     | "foxtrot" ->
1248:                         (fun a b -> Compare.foxtrot a#foxtrot b#foxtrot)
1249:                     | "golf" -> (fun a b -> Compare.golf a#golf b#golf)
1250:                     | "hotel" -> (fun a b -> Compare.hotel a#hotel b#hotel)
1251:                     | "india" -> (fun a b -> Compare.india a#india b#india)
1252:                     | "juliet" ->
1253:                         (fun a b -> Compare.juliet a#juliet b#juliet)
1254:                     | "kilo" -> (fun a b -> Compare.kilo a#kilo b#kilo)
1255:                     | "lima" -> (fun a b -> Compare.lima a#lima b#lima)
1256:                     | "mike" -> (fun a b -> Compare.mike a#mike b#mike)
1257:                     | "november" ->
1258:                         (fun a b -> Compare.november a#november b#november)
1259:                     | "oscar" -> (fun a b -> Compare.oscar a#oscar b#oscar)
1260:                     | "papa" -> (fun a b -> Compare.papa a#papa b#papa)
1261:                     | "quebec" ->
1262:                         (fun a b -> Compare.quebec a#quebec b#quebec)
1263:                     | "romeo" -> (fun a b -> Compare.romeo a#romeo b#romeo)
1264:                     | s -> raise (Invalid_field s)
1265:                     end
1266:                 | `Down s ->
1267:                     begin match s with
1268:                       "alpha" -> (fun a b -> Compare.alpha b#alpha a#alpha)
1269:                     | "bravo" -> (fun a b -> Compare.bravo b#bravo a#bravo)
1270:                     | "charlie" ->
1271:                         (fun a b -> Compare.charlie b#charlie a#charlie)
1272:                     | "delta" -> (fun a b -> Compare.delta b#delta a#delta)
1273:                     | "echo" -> (fun a b -> Compare.echo b#echo a#echo)
1274:                     | "foxtrot" ->
1275:                         (fun a b -> Compare.foxtrot b#foxtrot a#foxtrot)
1276:                     | "golf" -> (fun a b -> Compare.golf b#golf a#golf)
1277:                     | "hotel" -> (fun a b -> Compare.hotel b#hotel a#hotel)
1278:                     | "india" -> (fun a b -> Compare.india b#india a#india)
1279:                     | "juliet" ->
1280:                         (fun a b -> Compare.juliet b#juliet a#juliet)
1281:                     | "kilo" -> (fun a b -> Compare.kilo b#kilo a#kilo)
1282:                     | "lima" -> (fun a b -> Compare.lima b#lima a#lima)
1283:                     | "mike" -> (fun a b -> Compare.mike b#mike a#mike)
1284:                     | "november" ->
1285:                         (fun a b -> Compare.november b#november a#november)
1286:                     | "oscar" -> (fun a b -> Compare.oscar b#oscar a#oscar)
1287:                     | "papa" -> (fun a b -> Compare.papa b#papa a#papa)
1288:                     | "quebec" ->
1289:                         (fun a b -> Compare.quebec b#quebec a#quebec)
1290:                     | "romeo" -> (fun a b -> Compare.romeo b#romeo a#romeo)
1291:                     | s -> raise (Invalid_field s)
1292:                     end
1293:                 | `Custom f -> f)
1294:                l)
1295:         let compare_labels l =
1296:           Run_col.Run_col_main.multi_compare
1297:             (List.map
1298:                (function
1299:                   `Up s ->
1300:                     begin match s with
1301:                       "alpha" -> (fun a b -> Compare.alpha a#alpha b#alpha)
1302:                     | "Bravo!" -> (fun a b -> Compare.bravo a#bravo b#bravo)
1303:                     | "charlie" ->
1304:                         (fun a b -> Compare.charlie a#charlie b#charlie)
1305:                     | "delta" -> (fun a b -> Compare.delta a#delta b#delta)
1306:                     | "echo echo" -> (fun a b -> Compare.echo a#echo b#echo)
1307:                     | "foxtrot" ->
1308:                         (fun a b -> Compare.foxtrot a#foxtrot b#foxtrot)
1309:                     | "golf" -> (fun a b -> Compare.golf a#golf b#golf)
1310:                     | "hotel" -> (fun a b -> Compare.hotel a#hotel b#hotel)
1311:                     | "india" -> (fun a b -> Compare.india a#india b#india)
1312:                     | "juliet" ->
1313:                         (fun a b -> Compare.juliet a#juliet b#juliet)
1314:                     | "kilo" -> (fun a b -> Compare.kilo a#kilo b#kilo)
1315:                     | "lima" -> (fun a b -> Compare.lima a#lima b#lima)
1316:                     | "date (mm-yyyy)" ->
1317:                         (fun a b -> Compare.mike a#mike b#mike)
1318:                     | "november" ->
1319:                         (fun a b -> Compare.november a#november b#november)
1320:                     | "oscar" -> (fun a b -> Compare.oscar a#oscar b#oscar)
1321:                     | "papa" -> (fun a b -> Compare.papa a#papa b#papa)
1322:                     | "quebec" ->
1323:                         (fun a b -> Compare.quebec a#quebec b#quebec)
1324:                     | "romeo" -> (fun a b -> Compare.romeo a#romeo b#romeo)
1325:                     | s -> raise (Invalid_label s)
1326:                     end
1327:                 | `Down s ->
1328:                     begin match s with
1329:                       "alpha" -> (fun a b -> Compare.alpha b#alpha a#alpha)
1330:                     | "Bravo!" -> (fun a b -> Compare.bravo b#bravo a#bravo)
1331:                     | "charlie" ->
1332:                         (fun a b -> Compare.charlie b#charlie a#charlie)
1333:                     | "delta" -> (fun a b -> Compare.delta b#delta a#delta)
1334:                     | "echo echo" -> (fun a b -> Compare.echo b#echo a#echo)
1335:                     | "foxtrot" ->
1336:                         (fun a b -> Compare.foxtrot b#foxtrot a#foxtrot)
1337:                     | "golf" -> (fun a b -> Compare.golf b#golf a#golf)
1338:                     | "hotel" -> (fun a b -> Compare.hotel b#hotel a#hotel)
1339:                     | "india" -> (fun a b -> Compare.india b#india a#india)
1340:                     | "juliet" ->
1341:                         (fun a b -> Compare.juliet b#juliet a#juliet)
1342:                     | "kilo" -> (fun a b -> Compare.kilo b#kilo a#kilo)
1343:                     | "lima" -> (fun a b -> Compare.lima b#lima a#lima)
1344:                     | "date (mm-yyyy)" ->
1345:                         (fun a b -> Compare.mike b#mike a#mike)
1346:                     | "november" ->
1347:                         (fun a b -> Compare.november b#november a#november)
1348:                     | "oscar" -> (fun a b -> Compare.oscar b#oscar a#oscar)
1349:                     | "papa" -> (fun a b -> Compare.papa b#papa a#papa)
1350:                     | "quebec" ->
1351:                         (fun a b -> Compare.quebec b#quebec a#quebec)
1352:                     | "romeo" -> (fun a b -> Compare.romeo b#romeo a#romeo)
1353:                     | s -> raise (Invalid_label s)
1354:                     end
1355:                 | `Custom f -> f)
1356:                l)
1357:       end
1358:   end
1359: 
1360: (* An illustration of how to reuse record and variant types 
1361:    that are already defined.
1362: 
1363:    The Unix.stat type contains information about a given file. We want to
1364:    display this information for all the files of a directory, and sort
1365:    them the way we like.
1366: 
1367:    The following example is a program which takes a directory as argument,
1368:    and displays the full stat information on each file of the directory.
1369:    The rows are explicitely sorted so that directories (S_DIR) come before 
1370:    symbolic links (S_LNK) and regular files (S_REG).
1371: *)
1372: 
1373: (* We wrap this into a module to make things clear, but it's not necessary. *)
1374: module Test_predef =
1375:   struct
1376:     open Unix
1377:     (* *)
1378:     module File_kind =
1379:       struct
1380:         type t = file_kind
1381:         exception Bad_format
1382:         let of_string =
1383:           function
1384:             "S_CHR" -> S_CHR
1385:           | "S_BLK" -> S_BLK
1386:           | "S_FIFO" -> S_FIFO
1387:           | "S_SOCK" -> S_SOCK
1388:           | "S_DIR" -> S_DIR
1389:           | "S_LNK" -> S_LNK
1390:           | "S_REG" -> S_REG
1391:           | _ -> raise Bad_format
1392:         let to_string =
1393:           function
1394:             S_CHR -> "S_CHR"
1395:           | S_BLK -> "S_BLK"
1396:           | S_FIFO -> "S_FIFO"
1397:           | S_SOCK -> "S_SOCK"
1398:           | S_DIR -> "S_DIR"
1399:           | S_LNK -> "S_LNK"
1400:           | S_REG -> "S_REG"
1401:         let of_int =
1402:           function
1403:             0 -> S_CHR
1404:           | 1 -> S_BLK
1405:           | 2 -> S_FIFO
1406:           | 3 -> S_SOCK
1407:           | 4 -> S_DIR
1408:           | 5 -> S_LNK
1409:           | 6 -> S_REG
1410:           | _ -> raise Bad_format
1411:         let to_int =
1412:           function
1413:             S_CHR -> 0
1414:           | S_BLK -> 1
1415:           | S_FIFO -> 2
1416:           | S_SOCK -> 3
1417:           | S_DIR -> 4
1418:           | S_LNK -> 5
1419:           | S_REG -> 6
1420:         let compare a b = Pervasives.compare (to_int a) (to_int b)
1421:       end
1422:     (* *)
1423:     module Stats =
1424:       struct
1425:         let create
1426:           ~st_dev ~st_ino ~st_kind ~st_perm ~st_nlink ~st_uid ~st_gid ~st_rdev
1427:             ~st_size ~st_atime ~st_mtime ~st_ctime () =
1428:           {st_dev = st_dev; st_ino = st_ino; st_kind = st_kind;
1429:            st_perm = st_perm; st_nlink = st_nlink; st_uid = st_uid;
1430:            st_gid = st_gid; st_rdev = st_rdev; st_size = st_size;
1431:            st_atime = st_atime; st_mtime = st_mtime; st_ctime = st_ctime}
1432:         let create_tuple
1433:           ~st_dev
1434:             ~st_ino
1435:             ~st_kind
1436:             ~st_perm
1437:             ~st_nlink
1438:             ~st_uid
1439:             ~st_gid
1440:             ~st_rdev
1441:             ~st_size
1442:             ~st_atime
1443:             ~st_mtime
1444:             ~st_ctime
1445:             () :
1446:           int * int * File_kind.t * int * int * int * int * int * int *
1447:             float * float * float =
1448:           st_dev, st_ino, st_kind, st_perm, st_nlink, st_uid, st_gid, st_rdev,
1449:           st_size, st_atime, st_mtime, st_ctime
1450:         class
1451:           obj
1452:           ~st_dev
1453:           ~st_ino
1454:           ~st_kind
1455:           ~st_perm
1456:           ~st_nlink
1457:           ~st_uid
1458:           ~st_gid
1459:           ~st_rdev
1460:           ~st_size
1461:           ~st_atime
1462:           ~st_mtime
1463:           ~st_ctime
1464:           ()
1465:           =
1466:           object
1467:             val st_dev = (st_dev : int) method st_dev = st_dev
1468:             val st_ino = (st_ino : int) method st_ino = st_ino
1469:             val st_kind = (st_kind : File_kind.t) method st_kind = st_kind
1470:             val st_perm = (st_perm : int) method st_perm = st_perm
1471:             val st_nlink = (st_nlink : int) method st_nlink = st_nlink
1472:             val st_uid = (st_uid : int) method st_uid = st_uid
1473:             val st_gid = (st_gid : int) method st_gid = st_gid
1474:             val st_rdev = (st_rdev : int) method st_rdev = st_rdev
1475:             val st_size = (st_size : int) method st_size = st_size
1476:             val st_atime = (st_atime : float) method st_atime = st_atime
1477:             val st_mtime = (st_mtime : float) method st_mtime = st_mtime
1478:             val st_ctime = (st_ctime : float) method st_ctime = st_ctime
1479:           end
1480:         exception Bad_format
1481:         let st_dev_of_string = Run_col.Run_col_main.int_of_string Bad_format
1482:         and st_dev_to_string = string_of_int
1483:         and st_ino_of_string = Run_col.Run_col_main.int_of_string Bad_format
1484:         and st_ino_to_string = string_of_int
1485:         and st_kind_of_string = File_kind.of_string
1486:         and st_kind_to_string = File_kind.to_string
1487:         and st_perm_of_string = Run_col.Run_col_main.int_of_string Bad_format
1488:         and st_perm_to_string = string_of_int
1489:         and st_nlink_of_string = Run_col.Run_col_main.int_of_string Bad_format
1490:         and st_nlink_to_string = string_of_int
1491:         and st_uid_of_string = Run_col.Run_col_main.int_of_string Bad_format
1492:         and st_uid_to_string = string_of_int
1493:         and st_gid_of_string = Run_col.Run_col_main.int_of_string Bad_format
1494:         and st_gid_to_string = string_of_int
1495:         and st_rdev_of_string = Run_col.Run_col_main.int_of_string Bad_format
1496:         and st_rdev_to_string = string_of_int
1497:         and st_size_of_string = Run_col.Run_col_main.int_of_string Bad_format
1498:         and st_size_to_string = string_of_int
1499:         and st_atime_of_string =
1500:           Run_col.Run_col_main.float_of_string Bad_format
1501:         and st_atime_to_string = string_of_float
1502:         and st_mtime_of_string =
1503:           Run_col.Run_col_main.float_of_string Bad_format
1504:         and st_mtime_to_string = string_of_float
1505:         and st_ctime_of_string =
1506:           Run_col.Run_col_main.float_of_string Bad_format
1507:         and st_ctime_to_string = string_of_float
1508:         type t = stats
1509:         module Index =
1510:           struct
1511:             let st_dev = 0
1512:             let st_ino = 1
1513:             let st_kind = 2
1514:             let st_perm = 3
1515:             let st_nlink = 4
1516:             let st_uid = 5
1517:             let st_gid = 6
1518:             let st_rdev = 7
1519:             let st_size = 8
1520:             let st_atime = 9
1521:             let st_mtime = 10
1522:             let st_ctime = 11
1523:           end
1524:         module Compare =
1525:           struct
1526:             let st_dev = Pervasives.compare
1527:             let st_ino = Pervasives.compare
1528:             let st_kind = File_kind.compare
1529:             let st_perm = Pervasives.compare
1530:             let st_nlink = Pervasives.compare
1531:             let st_uid = Pervasives.compare
1532:             let st_gid = Pervasives.compare
1533:             let st_rdev = Pervasives.compare
1534:             let st_size = Pervasives.compare
1535:             let st_atime = Pervasives.compare
1536:             let st_mtime = Pervasives.compare
1537:             let st_ctime = Pervasives.compare
1538:           end
1539:         let fields =
1540:           [| "st_dev"; "st_ino"; "st_kind"; "st_perm"; "st_nlink"; "st_uid";
1541:              "st_gid"; "st_rdev"; "st_size"; "st_atime"; "st_mtime";
1542:              "st_ctime" |]
1543:         let labels =
1544:           [| "st_dev"; "st_ino"; "st_kind"; "st_perm"; "st_nlink"; "st_uid";
1545:              "st_gid"; "st_rdev"; "st_size"; "st_atime"; "st_mtime";
1546:              "st_ctime" |]
1547:         let of_array a =
1548:           {st_dev = st_dev_of_string a.(0); st_ino = st_ino_of_string a.(1);
1549:            st_kind = st_kind_of_string a.(2);
1550:            st_perm = st_perm_of_string a.(3);
1551:            st_nlink = st_nlink_of_string a.(4);
1552:            st_uid = st_uid_of_string a.(5); st_gid = st_gid_of_string a.(6);
1553:            st_rdev = st_rdev_of_string a.(7);
1554:            st_size = st_size_of_string a.(8);
1555:            st_atime = st_atime_of_string a.(9);
1556:            st_mtime = st_mtime_of_string a.(10);
1557:            st_ctime = st_ctime_of_string a.(11)}
1558:         let to_array r =
1559:           [| st_dev_to_string r.st_dev; st_ino_to_string r.st_ino;
1560:              st_kind_to_string r.st_kind; st_perm_to_string r.st_perm;
1561:              st_nlink_to_string r.st_nlink; st_uid_to_string r.st_uid;
1562:              st_gid_to_string r.st_gid; st_rdev_to_string r.st_rdev;
1563:              st_size_to_string r.st_size; st_atime_to_string r.st_atime;
1564:              st_mtime_to_string r.st_mtime; st_ctime_to_string r.st_ctime |]
1565:         exception Invalid_field of string
1566:         exception Invalid_label of string
1567:         let type_float_field =
1568:           function
1569:             "st_atime" -> (fun (r : t) -> r.st_atime)
1570:           | "st_mtime" -> (fun (r : t) -> r.st_mtime)
1571:           | "st_ctime" -> (fun (r : t) -> r.st_ctime)
1572:           | s -> raise (Invalid_field s)
1573:         let type_float_label =
1574:           function
1575:             "st_atime" -> (fun (r : t) -> r.st_atime)
1576:           | "st_mtime" -> (fun (r : t) -> r.st_mtime)
1577:           | "st_ctime" -> (fun (r : t) -> r.st_ctime)
1578:           | s -> raise (Invalid_label s)
1579:         let type_File_kind_field =
1580:           function
1581:             "st_kind" -> (fun (r : t) -> r.st_kind)
1582:           | s -> raise (Invalid_field s)
1583:         let type_File_kind_label =
1584:           function
1585:             "st_kind" -> (fun (r : t) -> r.st_kind)
1586:           | s -> raise (Invalid_label s)
1587:         let type_int_field =
1588:           function
1589:             "st_dev" -> (fun (r : t) -> r.st_dev)
1590:           | "st_ino" -> (fun (r : t) -> r.st_ino)
1591:           | "st_perm" -> (fun (r : t) -> r.st_perm)
1592:           | "st_nlink" -> (fun (r : t) -> r.st_nlink)
1593:           | "st_uid" -> (fun (r : t) -> r.st_uid)
1594:           | "st_gid" -> (fun (r : t) -> r.st_gid)
1595:           | "st_rdev" -> (fun (r : t) -> r.st_rdev)
1596:           | "st_size" -> (fun (r : t) -> r.st_size)
1597:           | s -> raise (Invalid_field s)
1598:         let type_int_label =
1599:           function
1600:             "st_dev" -> (fun (r : t) -> r.st_dev)
1601:           | "st_ino" -> (fun (r : t) -> r.st_ino)
1602:           | "st_perm" -> (fun (r : t) -> r.st_perm)
1603:           | "st_nlink" -> (fun (r : t) -> r.st_nlink)
1604:           | "st_uid" -> (fun (r : t) -> r.st_uid)
1605:           | "st_gid" -> (fun (r : t) -> r.st_gid)
1606:           | "st_rdev" -> (fun (r : t) -> r.st_rdev)
1607:           | "st_size" -> (fun (r : t) -> r.st_size)
1608:           | s -> raise (Invalid_label s)
1609:         let load_csv_rows =
1610:           fun ?strict ->
1611:             fun ?noheader file f ->
1612:               Run_col.Run_col_main.input_csv_file ?strict ?noheader labels
1613:                 of_array file f
1614:         let load_csv =
1615:           fun ?strict ->
1616:             fun ?noheader ->
1617:               fun ?rev file ->
1618:                 Run_col.Run_col_main.input_csv_list_file ?strict ?noheader
1619:                   ?rev labels of_array file
1620:         let open_out_csv =
1621:           fun ?sep ->
1622:             fun ?noheader file ->
1623:               Run_col.Run_col_main.open_out_csv ?sep ?noheader labels to_array
1624:                 file
1625:         let save_csv_rows =
1626:           fun ?sep ->
1627:             fun ?noheader file f ->
1628:               Run_col.Run_col_main.output_csv_file ?sep ?noheader labels
1629:                 to_array file f
1630:         let save_csv =
1631:           fun ?sep ->
1632:             fun ?noheader file l ->
1633:               Run_col.Run_col_main.output_csv_list_file ?sep ?noheader labels
1634:                 to_array file l
1635:         let compare_fields l =
1636:           Run_col.Run_col_main.multi_compare
1637:             (List.map
1638:                (function
1639:                   `Up s ->
1640:                     begin match s with
1641:                       "st_dev" ->
1642:                         (fun a b -> Compare.st_dev a.st_dev b.st_dev)
1643:                     | "st_ino" ->
1644:                         (fun a b -> Compare.st_ino a.st_ino b.st_ino)
1645:                     | "st_kind" ->
1646:                         (fun a b -> Compare.st_kind a.st_kind b.st_kind)
1647:                     | "st_perm" ->
1648:                         (fun a b -> Compare.st_perm a.st_perm b.st_perm)
1649:                     | "st_nlink" ->
1650:                         (fun a b -> Compare.st_nlink a.st_nlink b.st_nlink)
1651:                     | "st_uid" ->
1652:                         (fun a b -> Compare.st_uid a.st_uid b.st_uid)
1653:                     | "st_gid" ->
1654:                         (fun a b -> Compare.st_gid a.st_gid b.st_gid)
1655:                     | "st_rdev" ->
1656:                         (fun a b -> Compare.st_rdev a.st_rdev b.st_rdev)
1657:                     | "st_size" ->
1658:                         (fun a b -> Compare.st_size a.st_size b.st_size)
1659:                     | "st_atime" ->
1660:                         (fun a b -> Compare.st_atime a.st_atime b.st_atime)
1661:                     | "st_mtime" ->
1662:                         (fun a b -> Compare.st_mtime a.st_mtime b.st_mtime)
1663:                     | "st_ctime" ->
1664:                         (fun a b -> Compare.st_ctime a.st_ctime b.st_ctime)
1665:                     | s -> raise (Invalid_field s)
1666:                     end
1667:                 | `Down s ->
1668:                     begin match s with
1669:                       "st_dev" ->
1670:                         (fun a b -> Compare.st_dev b.st_dev a.st_dev)
1671:                     | "st_ino" ->
1672:                         (fun a b -> Compare.st_ino b.st_ino a.st_ino)
1673:                     | "st_kind" ->
1674:                         (fun a b -> Compare.st_kind b.st_kind a.st_kind)
1675:                     | "st_perm" ->
1676:                         (fun a b -> Compare.st_perm b.st_perm a.st_perm)
1677:                     | "st_nlink" ->
1678:                         (fun a b -> Compare.st_nlink b.st_nlink a.st_nlink)
1679:                     | "st_uid" ->
1680:                         (fun a b -> Compare.st_uid b.st_uid a.st_uid)
1681:                     | "st_gid" ->
1682:                         (fun a b -> Compare.st_gid b.st_gid a.st_gid)
1683:                     | "st_rdev" ->
1684:                         (fun a b -> Compare.st_rdev b.st_rdev a.st_rdev)
1685:                     | "st_size" ->
1686:                         (fun a b -> Compare.st_size b.st_size a.st_size)
1687:                     | "st_atime" ->
1688:                         (fun a b -> Compare.st_atime b.st_atime a.st_atime)
1689:                     | "st_mtime" ->
1690:                         (fun a b -> Compare.st_mtime b.st_mtime a.st_mtime)
1691:                     | "st_ctime" ->
1692:                         (fun a b -> Compare.st_ctime b.st_ctime a.st_ctime)
1693:                     | s -> raise (Invalid_field s)
1694:                     end
1695:                 | `Custom f -> f)
1696:                l)
1697:         let compare_labels l =
1698:           Run_col.Run_col_main.multi_compare
1699:             (List.map
1700:                (function
1701:                   `Up s ->
1702:                     begin match s with
1703:                       "st_dev" ->
1704:                         (fun a b -> Compare.st_dev a.st_dev b.st_dev)
1705:                     | "st_ino" ->
1706:                         (fun a b -> Compare.st_ino a.st_ino b.st_ino)
1707:                     | "st_kind" ->
1708:                         (fun a b -> Compare.st_kind a.st_kind b.st_kind)
1709:                     | "st_perm" ->
1710:                         (fun a b -> Compare.st_perm a.st_perm b.st_perm)
1711:                     | "st_nlink" ->
1712:                         (fun a b -> Compare.st_nlink a.st_nlink b.st_nlink)
1713:                     | "st_uid" ->
1714:                         (fun a b -> Compare.st_uid a.st_uid b.st_uid)
1715:                     | "st_gid" ->
1716:                         (fun a b -> Compare.st_gid a.st_gid b.st_gid)
1717:                     | "st_rdev" ->
1718:                         (fun a b -> Compare.st_rdev a.st_rdev b.st_rdev)
1719:                     | "st_size" ->
1720:                         (fun a b -> Compare.st_size a.st_size b.st_size)
1721:                     | "st_atime" ->
1722:                         (fun a b -> Compare.st_atime a.st_atime b.st_atime)
1723:                     | "st_mtime" ->
1724:                         (fun a b -> Compare.st_mtime a.st_mtime b.st_mtime)
1725:                     | "st_ctime" ->
1726:                         (fun a b -> Compare.st_ctime a.st_ctime b.st_ctime)
1727:                     | s -> raise (Invalid_label s)
1728:                     end
1729:                 | `Down s ->
1730:                     begin match s with
1731:                       "st_dev" ->
1732:                         (fun a b -> Compare.st_dev b.st_dev a.st_dev)
1733:                     | "st_ino" ->
1734:                         (fun a b -> Compare.st_ino b.st_ino a.st_ino)
1735:                     | "st_kind" ->
1736:                         (fun a b -> Compare.st_kind b.st_kind a.st_kind)
1737:                     | "st_perm" ->
1738:                         (fun a b -> Compare.st_perm b.st_perm a.st_perm)
1739:                     | "st_nlink" ->
1740:                         (fun a b -> Compare.st_nlink b.st_nlink a.st_nlink)
1741:                     | "st_uid" ->
1742:                         (fun a b -> Compare.st_uid b.st_uid a.st_uid)
1743:                     | "st_gid" ->
1744:                         (fun a b -> Compare.st_gid b.st_gid a.st_gid)
1745:                     | "st_rdev" ->
1746:                         (fun a b -> Compare.st_rdev b.st_rdev a.st_rdev)
1747:                     | "st_size" ->
1748:                         (fun a b -> Compare.st_size b.st_size a.st_size)
1749:                     | "st_atime" ->
1750:                         (fun a b -> Compare.st_atime b.st_atime a.st_atime)
1751:                     | "st_mtime" ->
1752:                         (fun a b -> Compare.st_mtime b.st_mtime a.st_mtime)
1753:                     | "st_ctime" ->
1754:                         (fun a b -> Compare.st_ctime b.st_ctime a.st_ctime)
1755:                     | s -> raise (Invalid_label s)
1756:                     end
1757:                 | `Custom f -> f)
1758:                l)
1759:         module Tup =
1760:           struct
1761:             type t =
1762:               int * int * File_kind.t * int * int * int * int * int * int *
1763:                 float * float * float
1764:             let create = create_tuple
1765:             let of_array a =
1766:               st_dev_of_string a.(0), st_ino_of_string a.(1),
1767:               st_kind_of_string a.(2), st_perm_of_string a.(3),
1768:               st_nlink_of_string a.(4), st_uid_of_string a.(5),
1769:               st_gid_of_string a.(6), st_rdev_of_string a.(7),
1770:               st_size_of_string a.(8), st_atime_of_string a.(9),
1771:               st_mtime_of_string a.(10), st_ctime_of_string a.(11)
1772:             let to_array
1773:               (st_dev, st_ino, st_kind, st_perm, st_nlink, st_uid, st_gid,
1774:                st_rdev, st_size, st_atime, st_mtime, st_ctime) =
1775:               [| st_dev_to_string st_dev; st_ino_to_string st_ino;
1776:                  st_kind_to_string st_kind; st_perm_to_string st_perm;
1777:                  st_nlink_to_string st_nlink; st_uid_to_string st_uid;
1778:                  st_gid_to_string st_gid; st_rdev_to_string st_rdev;
1779:                  st_size_to_string st_size; st_atime_to_string st_atime;
1780:                  st_mtime_to_string st_mtime; st_ctime_to_string st_ctime |]
1781:             let of_record r : t =
1782:               r.st_dev, r.st_ino, r.st_kind, r.st_perm, r.st_nlink, r.st_uid,
1783:               r.st_gid, r.st_rdev, r.st_size, r.st_atime, r.st_mtime,
1784:               r.st_ctime
1785:             let to_record
1786:               (st_dev, st_ino, st_kind, st_perm, st_nlink, st_uid, st_gid,
1787:                st_rdev, st_size, st_atime, st_mtime, st_ctime :
1788:                t) =
1789:               {st_dev = st_dev; st_ino = st_ino; st_kind = st_kind;
1790:                st_perm = st_perm; st_nlink = st_nlink; st_uid = st_uid;
1791:                st_gid = st_gid; st_rdev = st_rdev; st_size = st_size;
1792:                st_atime = st_atime; st_mtime = st_mtime; st_ctime = st_ctime}
1793:             let get_st_dev (x, _, _, _, _, _, _, _, _, _, _, _ : t) = x
1794:             and get_st_ino (_, x, _, _, _, _, _, _, _, _, _, _ : t) = x
1795:             and get_st_kind (_, _, x, _, _, _, _, _, _, _, _, _ : t) = x
1796:             and get_st_perm (_, _, _, x, _, _, _, _, _, _, _, _ : t) = x
1797:             and get_st_nlink (_, _, _, _, x, _, _, _, _, _, _, _ : t) = x
1798:             and get_st_uid (_, _, _, _, _, x, _, _, _, _, _, _ : t) = x
1799:             and get_st_gid (_, _, _, _, _, _, x, _, _, _, _, _ : t) = x
1800:             and get_st_rdev (_, _, _, _, _, _, _, x, _, _, _, _ : t) = x
1801:             and get_st_size (_, _, _, _, _, _, _, _, x, _, _, _ : t) = x
1802:             and get_st_atime (_, _, _, _, _, _, _, _, _, x, _, _ : t) = x
1803:             and get_st_mtime (_, _, _, _, _, _, _, _, _, _, x, _ : t) = x
1804:             and get_st_ctime (_, _, _, _, _, _, _, _, _, _, _, x : t) = x
1805:             exception Invalid_field of string
1806:             exception Invalid_label of string
1807:             let type_float_field =
1808:               function
1809:                 "st_atime" ->
1810:                   (fun (_, _, _, _, _, _, _, _, _, x, _, _ : t) -> x)
1811:               | "st_mtime" ->
1812:                   (fun (_, _, _, _, _, _, _, _, _, _, x, _ : t) -> x)
1813:               | "st_ctime" ->
1814:                   (fun (_, _, _, _, _, _, _, _, _, _, _, x : t) -> x)
1815:               | s -> raise (Invalid_field s)
1816:             let type_float_label =
1817:               function
1818:                 "st_atime" ->
1819:                   (fun (_, _, _, _, _, _, _, _, _, x, _, _ : t) -> x)
1820:               | "st_mtime" ->
1821:                   (fun (_, _, _, _, _, _, _, _, _, _, x, _ : t) -> x)
1822:               | "st_ctime" ->
1823:                   (fun (_, _, _, _, _, _, _, _, _, _, _, x : t) -> x)
1824:               | s -> raise (Invalid_label s)
1825:             let type_File_kind_field =
1826:               function
1827:                 "st_kind" ->
1828:                   (fun (_, _, x, _, _, _, _, _, _, _, _, _ : t) -> x)
1829:               | s -> raise (Invalid_field s)
1830:             let type_File_kind_label =
1831:               function
1832:                 "st_kind" ->
1833:                   (fun (_, _, x, _, _, _, _, _, _, _, _, _ : t) -> x)
1834:               | s -> raise (Invalid_label s)
1835:             let type_int_field =
1836:               function
1837:                 "st_dev" ->
1838:                   (fun (x, _, _, _, _, _, _, _, _, _, _, _ : t) -> x)
1839:               | "st_ino" ->
1840:                   (fun (_, x, _, _, _, _, _, _, _, _, _, _ : t) -> x)
1841:               | "st_perm" ->
1842:                   (fun (_, _, _, x, _, _, _, _, _, _, _, _ : t) -> x)
1843:               | "st_nlink" ->
1844:                   (fun (_, _, _, _, x, _, _, _, _, _, _, _ : t) -> x)
1845:               | "st_uid" ->
1846:                   (fun (_, _, _, _, _, x, _, _, _, _, _, _ : t) -> x)
1847:               | "st_gid" ->
1848:                   (fun (_, _, _, _, _, _, x, _, _, _, _, _ : t) -> x)
1849:               | "st_rdev" ->
1850:                   (fun (_, _, _, _, _, _, _, x, _, _, _, _ : t) -> x)
1851:               | "st_size" ->
1852:                   (fun (_, _, _, _, _, _, _, _, x, _, _, _ : t) -> x)
1853:               | s -> raise (Invalid_field s)
1854:             let type_int_label =
1855:               function
1856:                 "st_dev" ->
1857:                   (fun (x, _, _, _, _, _, _, _, _, _, _, _ : t) -> x)
1858:               | "st_ino" ->
1859:                   (fun (_, x, _, _, _, _, _, _, _, _, _, _ : t) -> x)
1860:               | "st_perm" ->
1861:                   (fun (_, _, _, x, _, _, _, _, _, _, _, _ : t) -> x)
1862:               | "st_nlink" ->
1863:                   (fun (_, _, _, _, x, _, _, _, _, _, _, _ : t) -> x)
1864:               | "st_uid" ->
1865:                   (fun (_, _, _, _, _, x, _, _, _, _, _, _ : t) -> x)
1866:               | "st_gid" ->
1867:                   (fun (_, _, _, _, _, _, x, _, _, _, _, _ : t) -> x)
1868:               | "st_rdev" ->
1869:                   (fun (_, _, _, _, _, _, _, x, _, _, _, _ : t) -> x)
1870:               | "st_size" ->
1871:                   (fun (_, _, _, _, _, _, _, _, x, _, _, _ : t) -> x)
1872:               | s -> raise (Invalid_label s)
1873:             let load_csv_rows =
1874:               fun ?strict ->
1875:                 fun ?noheader file f ->
1876:                   Run_col.Run_col_main.input_csv_file ?strict ?noheader labels
1877:                     of_array file f
1878:             let load_csv =
1879:               fun ?strict ->
1880:                 fun ?noheader ->
1881:                   fun ?rev file ->
1882:                     Run_col.Run_col_main.input_csv_list_file ?strict ?noheader
1883:                       ?rev labels of_array file
1884:             let open_out_csv =
1885:               fun ?sep ->
1886:                 fun ?noheader file ->
1887:                   Run_col.Run_col_main.open_out_csv ?sep ?noheader labels
1888:                     to_array file
1889:             let save_csv_rows =
1890:               fun ?sep ->
1891:                 fun ?noheader file f ->
1892:                   Run_col.Run_col_main.output_csv_file ?sep ?noheader labels
1893:                     to_array file f
1894:             let save_csv =
1895:               fun ?sep ->
1896:                 fun ?noheader file l ->
1897:                   Run_col.Run_col_main.output_csv_list_file ?sep ?noheader
1898:                     labels to_array file l
1899:             let compare_fields l =
1900:               Run_col.Run_col_main.multi_compare
1901:                 (List.map
1902:                    (function
1903:                       `Up s ->
1904:                         begin match s with
1905:                           "st_dev" ->
1906:                             (fun a b ->
1907:                                Compare.st_dev (get_st_dev a) (get_st_dev b))
1908:                         | "st_ino" ->
1909:                             (fun a b ->
1910:                                Compare.st_ino (get_st_ino a) (get_st_ino b))
1911:                         | "st_kind" ->
1912:                             (fun a b ->
1913:                                Compare.st_kind (get_st_kind a)
1914:                                  (get_st_kind b))
1915:                         | "st_perm" ->
1916:                             (fun a b ->
1917:                                Compare.st_perm (get_st_perm a)
1918:                                  (get_st_perm b))
1919:                         | "st_nlink" ->
1920:                             (fun a b ->
1921:                                Compare.st_nlink (get_st_nlink a)
1922:                                  (get_st_nlink b))
1923:                         | "st_uid" ->
1924:                             (fun a b ->
1925:                                Compare.st_uid (get_st_uid a) (get_st_uid b))
1926:                         | "st_gid" ->
1927:                             (fun a b ->
1928:                                Compare.st_gid (get_st_gid a) (get_st_gid b))
1929:                         | "st_rdev" ->
1930:                             (fun a b ->
1931:                                Compare.st_rdev (get_st_rdev a)
1932:                                  (get_st_rdev b))
1933:                         | "st_size" ->
1934:                             (fun a b ->
1935:                                Compare.st_size (get_st_size a)
1936:                                  (get_st_size b))
1937:                         | "st_atime" ->
1938:                             (fun a b ->
1939:                                Compare.st_atime (get_st_atime a)
1940:                                  (get_st_atime b))
1941:                         | "st_mtime" ->
1942:                             (fun a b ->
1943:                                Compare.st_mtime (get_st_mtime a)
1944:                                  (get_st_mtime b))
1945:                         | "st_ctime" ->
1946:                             (fun a b ->
1947:                                Compare.st_ctime (get_st_ctime a)
1948:                                  (get_st_ctime b))
1949:                         | s -> raise (Invalid_field s)
1950:                         end
1951:                     | `Down s ->
1952:                         begin match s with
1953:                           "st_dev" ->
1954:                             (fun a b ->
1955:                                Compare.st_dev (get_st_dev b) (get_st_dev a))
1956:                         | "st_ino" ->
1957:                             (fun a b ->
1958:                                Compare.st_ino (get_st_ino b) (get_st_ino a))
1959:                         | "st_kind" ->
1960:                             (fun a b ->
1961:                                Compare.st_kind (get_st_kind b)
1962:                                  (get_st_kind a))
1963:                         | "st_perm" ->
1964:                             (fun a b ->
1965:                                Compare.st_perm (get_st_perm b)
1966:                                  (get_st_perm a))
1967:                         | "st_nlink" ->
1968:                             (fun a b ->
1969:                                Compare.st_nlink (get_st_nlink b)
1970:                                  (get_st_nlink a))
1971:                         | "st_uid" ->
1972:                             (fun a b ->
1973:                                Compare.st_uid (get_st_uid b) (get_st_uid a))
1974:                         | "st_gid" ->
1975:                             (fun a b ->
1976:                                Compare.st_gid (get_st_gid b) (get_st_gid a))
1977:                         | "st_rdev" ->
1978:                             (fun a b ->
1979:                                Compare.st_rdev (get_st_rdev b)
1980:                                  (get_st_rdev a))
1981:                         | "st_size" ->
1982:                             (fun a b ->
1983:                                Compare.st_size (get_st_size b)
1984:                                  (get_st_size a))
1985:                         | "st_atime" ->
1986:                             (fun a b ->
1987:                                Compare.st_atime (get_st_atime b)
1988:                                  (get_st_atime a))
1989:                         | "st_mtime" ->
1990:                             (fun a b ->
1991:                                Compare.st_mtime (get_st_mtime b)
1992:                                  (get_st_mtime a))
1993:                         | "st_ctime" ->
1994:                             (fun a b ->
1995:                                Compare.st_ctime (get_st_ctime b)
1996:                                  (get_st_ctime a))
1997:                         | s -> raise (Invalid_field s)
1998:                         end
1999:                     | `Custom f -> f)
2000:                    l)
2001:             let compare_labels l =
2002:               Run_col.Run_col_main.multi_compare
2003:                 (List.map
2004:                    (function
2005:                       `Up s ->
2006:                         begin match s with
2007:                           "st_dev" ->
2008:                             (fun a b ->
2009:                                Compare.st_dev (get_st_dev a) (get_st_dev b))
2010:                         | "st_ino" ->
2011:                             (fun a b ->
2012:                                Compare.st_ino (get_st_ino a) (get_st_ino b))
2013:                         | "st_kind" ->
2014:                             (fun a b ->
2015:                                Compare.st_kind (get_st_kind a)
2016:                                  (get_st_kind b))
2017:                         | "st_perm" ->
2018:                             (fun a b ->
2019:                                Compare.st_perm (get_st_perm a)
2020:                                  (get_st_perm b))
2021:                         | "st_nlink" ->
2022:                             (fun a b ->
2023:                                Compare.st_nlink (get_st_nlink a)
2024:                                  (get_st_nlink b))
2025:                         | "st_uid" ->
2026:                             (fun a b ->
2027:                                Compare.st_uid (get_st_uid a) (get_st_uid b))
2028:                         | "st_gid" ->
2029:                             (fun a b ->
2030:                                Compare.st_gid (get_st_gid a) (get_st_gid b))
2031:                         | "st_rdev" ->
2032:                             (fun a b ->
2033:                                Compare.st_rdev (get_st_rdev a)
2034:                                  (get_st_rdev b))
2035:                         | "st_size" ->
2036:                             (fun a b ->
2037:                                Compare.st_size (get_st_size a)
2038:                                  (get_st_size b))
2039:                         | "st_atime" ->
2040:                             (fun a b ->
2041:                                Compare.st_atime (get_st_atime a)
2042:                                  (get_st_atime b))
2043:                         | "st_mtime" ->
2044:                             (fun a b ->
2045:                                Compare.st_mtime (get_st_mtime a)
2046:                                  (get_st_mtime b))
2047:                         | "st_ctime" ->
2048:                             (fun a b ->
2049:                                Compare.st_ctime (get_st_ctime a)
2050:                                  (get_st_ctime b))
2051:                         | s -> raise (Invalid_label s)
2052:                         end
2053:                     | `Down s ->
2054:                         begin match s with
2055:                           "st_dev" ->
2056:                             (fun a b ->
2057:                                Compare.st_dev (get_st_dev b) (get_st_dev a))
2058:                         | "st_ino" ->
2059:                             (fun a b ->
2060:                                Compare.st_ino (get_st_ino b) (get_st_ino a))
2061:                         | "st_kind" ->
2062:                             (fun a b ->
2063:                                Compare.st_kind (get_st_kind b)
2064:                                  (get_st_kind a))
2065:                         | "st_perm" ->
2066:                             (fun a b ->
2067:                                Compare.st_perm (get_st_perm b)
2068:                                  (get_st_perm a))
2069:                         | "st_nlink" ->
2070:                             (fun a b ->
2071:                                Compare.st_nlink (get_st_nlink b)
2072:                                  (get_st_nlink a))
2073:                         | "st_uid" ->
2074:                             (fun a b ->
2075:                                Compare.st_uid (get_st_uid b) (get_st_uid a))
2076:                         | "st_gid" ->
2077:                             (fun a b ->
2078:                                Compare.st_gid (get_st_gid b) (get_st_gid a))
2079:                         | "st_rdev" ->
2080:                             (fun a b ->
2081:                                Compare.st_rdev (get_st_rdev b)
2082:                                  (get_st_rdev a))
2083:                         | "st_size" ->
2084:                             (fun a b ->
2085:                                Compare.st_size (get_st_size b)
2086:                                  (get_st_size a))
2087:                         | "st_atime" ->
2088:                             (fun a b ->
2089:                                Compare.st_atime (get_st_atime b)
2090:                                  (get_st_atime a))
2091:                         | "st_mtime" ->
2092:                             (fun a b ->
2093:                                Compare.st_mtime (get_st_mtime b)
2094:                                  (get_st_mtime a))
2095:                         | "st_ctime" ->
2096:                             (fun a b ->
2097:                                Compare.st_ctime (get_st_ctime b)
2098:                                  (get_st_ctime a))
2099:                         | s -> raise (Invalid_label s)
2100:                         end
2101:                     | `Custom f -> f)
2102:                    l)
2103:           end
2104:         module OO =
2105:           struct
2106:             class t = obj
2107:             let create = new t
2108:             let of_array a =
2109:               new t ~st_dev:(st_dev_of_string a.(0))
2110:                 ~st_ino:(st_ino_of_string a.(1))
2111:                 ~st_kind:(st_kind_of_string a.(2))
2112:                 ~st_perm:(st_perm_of_string a.(3))
2113:                 ~st_nlink:(st_nlink_of_string a.(4))
2114:                 ~st_uid:(st_uid_of_string a.(5))
2115:                 ~st_gid:(st_gid_of_string a.(6))
2116:                 ~st_rdev:(st_rdev_of_string a.(7))
2117:                 ~st_size:(st_size_of_string a.(8))
2118:                 ~st_atime:(st_atime_of_string a.(9))
2119:                 ~st_mtime:(st_mtime_of_string a.(10))
2120:                 ~st_ctime:(st_ctime_of_string a.(11)) ()
2121:             let to_array o =
2122:               [| st_dev_to_string o#st_dev; st_ino_to_string o#st_ino;
2123:                  st_kind_to_string o#st_kind; st_perm_to_string o#st_perm;
2124:                  st_nlink_to_string o#st_nlink; st_uid_to_string o#st_uid;
2125:                  st_gid_to_string o#st_gid; st_rdev_to_string o#st_rdev;
2126:                  st_size_to_string o#st_size; st_atime_to_string o#st_atime;
2127:                  st_mtime_to_string o#st_mtime;
2128:                  st_ctime_to_string o#st_ctime |]
2129:             let of_record r =
2130:               new t ~st_dev:(r.st_dev) ~st_ino:(r.st_ino) ~st_kind:(r.st_kind)
2131:                 ~st_perm:(r.st_perm) ~st_nlink:(r.st_nlink) ~st_uid:(r.st_uid)
2132:                 ~st_gid:(r.st_gid) ~st_rdev:(r.st_rdev) ~st_size:(r.st_size)
2133:                 ~st_atime:(r.st_atime) ~st_mtime:(r.st_mtime)
2134:                 ~st_ctime:(r.st_ctime) ()
2135:             let to_record o =
2136:               {st_dev = o#st_dev; st_ino = o#st_ino; st_kind = o#st_kind;
2137:                st_perm = o#st_perm; st_nlink = o#st_nlink; st_uid = o#st_uid;
2138:                st_gid = o#st_gid; st_rdev = o#st_rdev; st_size = o#st_size;
2139:                st_atime = o#st_atime; st_mtime = o#st_mtime;
2140:                st_ctime = o#st_ctime}
2141:             exception Invalid_field of string
2142:             exception Invalid_label of string
2143:             let type_float_field =
2144:               function
2145:                 "st_atime" -> (fun (o : t) -> o#st_atime)
2146:               | "st_mtime" -> (fun (o : t) -> o#st_mtime)
2147:               | "st_ctime" -> (fun (o : t) -> o#st_ctime)
2148:               | s -> raise (Invalid_field s)
2149:             let type_float_label =
2150:               function
2151:                 "st_atime" -> (fun (o : t) -> o#st_atime)
2152:               | "st_mtime" -> (fun (o : t) -> o#st_mtime)
2153:               | "st_ctime" -> (fun (o : t) -> o#st_ctime)
2154:               | s -> raise (Invalid_label s)
2155:             let type_File_kind_field =
2156:               function
2157:                 "st_kind" -> (fun (o : t) -> o#st_kind)
2158:               | s -> raise (Invalid_field s)
2159:             let type_File_kind_label =
2160:               function
2161:                 "st_kind" -> (fun (o : t) -> o#st_kind)
2162:               | s -> raise (Invalid_label s)
2163:             let type_int_field =
2164:               function
2165:                 "st_dev" -> (fun (o : t) -> o#st_dev)
2166:               | "st_ino" -> (fun (o : t) -> o#st_ino)
2167:               | "st_perm" -> (fun (o : t) -> o#st_perm)
2168:               | "st_nlink" -> (fun (o : t) -> o#st_nlink)
2169:               | "st_uid" -> (fun (o : t) -> o#st_uid)
2170:               | "st_gid" -> (fun (o : t) -> o#st_gid)
2171:               | "st_rdev" -> (fun (o : t) -> o#st_rdev)
2172:               | "st_size" -> (fun (o : t) -> o#st_size)
2173:               | s -> raise (Invalid_field s)
2174:             let type_int_label =
2175:               function
2176:                 "st_dev" -> (fun (o : t) -> o#st_dev)
2177:               | "st_ino" -> (fun (o : t) -> o#st_ino)
2178:               | "st_perm" -> (fun (o : t) -> o#st_perm)
2179:               | "st_nlink" -> (fun (o : t) -> o#st_nlink)
2180:               | "st_uid" -> (fun (o : t) -> o#st_uid)
2181:               | "st_gid" -> (fun (o : t) -> o#st_gid)
2182:               | "st_rdev" -> (fun (o : t) -> o#st_rdev)
2183:               | "st_size" -> (fun (o : t) -> o#st_size)
2184:               | s -> raise (Invalid_label s)
2185:             let load_csv_rows =
2186:               fun ?strict ->
2187:                 fun ?noheader file f ->
2188:                   Run_col.Run_col_main.input_csv_file ?strict ?noheader labels
2189:                     of_array file f
2190:             let load_csv =
2191:               fun ?strict ->
2192:                 fun ?noheader ->
2193:                   fun ?rev file ->
2194:                     Run_col.Run_col_main.input_csv_list_file ?strict ?noheader
2195:                       ?rev labels of_array file
2196:             let open_out_csv =
2197:               fun ?sep ->
2198:                 fun ?noheader file ->
2199:                   Run_col.Run_col_main.open_out_csv ?sep ?noheader labels
2200:                     to_array file
2201:             let save_csv_rows =
2202:               fun ?sep ->
2203:                 fun ?noheader file f ->
2204:                   Run_col.Run_col_main.output_csv_file ?sep ?noheader labels
2205:                     to_array file f
2206:             let save_csv =
2207:               fun ?sep ->
2208:                 fun ?noheader file l ->
2209:                   Run_col.Run_col_main.output_csv_list_file ?sep ?noheader
2210:                     labels to_array file l
2211:             let compare_fields l =
2212:               Run_col.Run_col_main.multi_compare
2213:                 (List.map
2214:                    (function
2215:                       `Up s ->
2216:                         begin match s with
2217:                           "st_dev" ->
2218:                             (fun a b -> Compare.st_dev a#st_dev b#st_dev)
2219:                         | "st_ino" ->
2220:                             (fun a b -> Compare.st_ino a#st_ino b#st_ino)
2221:                         | "st_kind" ->
2222:                             (fun a b -> Compare.st_kind a#st_kind b#st_kind)
2223:                         | "st_perm" ->
2224:                             (fun a b -> Compare.st_perm a#st_perm b#st_perm)
2225:                         | "st_nlink" ->
2226:                             (fun a b ->
2227:                                Compare.st_nlink a#st_nlink b#st_nlink)
2228:                         | "st_uid" ->
2229:                             (fun a b -> Compare.st_uid a#st_uid b#st_uid)
2230:                         | "st_gid" ->
2231:                             (fun a b -> Compare.st_gid a#st_gid b#st_gid)
2232:                         | "st_rdev" ->
2233:                             (fun a b -> Compare.st_rdev a#st_rdev b#st_rdev)
2234:                         | "st_size" ->
2235:                             (fun a b -> Compare.st_size a#st_size b#st_size)
2236:                         | "st_atime" ->
2237:                             (fun a b ->
2238:                                Compare.st_atime a#st_atime b#st_atime)
2239:                         | "st_mtime" ->
2240:                             (fun a b ->
2241:                                Compare.st_mtime a#st_mtime b#st_mtime)
2242:                         | "st_ctime" ->
2243:                             (fun a b ->
2244:                                Compare.st_ctime a#st_ctime b#st_ctime)
2245:                         | s -> raise (Invalid_field s)
2246:                         end
2247:                     | `Down s ->
2248:                         begin match s with
2249:                           "st_dev" ->
2250:                             (fun a b -> Compare.st_dev b#st_dev a#st_dev)
2251:                         | "st_ino" ->
2252:                             (fun a b -> Compare.st_ino b#st_ino a#st_ino)
2253:                         | "st_kind" ->
2254:                             (fun a b -> Compare.st_kind b#st_kind a#st_kind)
2255:                         | "st_perm" ->
2256:                             (fun a b -> Compare.st_perm b#st_perm a#st_perm)
2257:                         | "st_nlink" ->
2258:                             (fun a b ->
2259:                                Compare.st_nlink b#st_nlink a#st_nlink)
2260:                         | "st_uid" ->
2261:                             (fun a b -> Compare.st_uid b#st_uid a#st_uid)
2262:                         | "st_gid" ->
2263:                             (fun a b -> Compare.st_gid b#st_gid a#st_gid)
2264:                         | "st_rdev" ->
2265:                             (fun a b -> Compare.st_rdev b#st_rdev a#st_rdev)
2266:                         | "st_size" ->
2267:                             (fun a b -> Compare.st_size b#st_size a#st_size)
2268:                         | "st_atime" ->
2269:                             (fun a b ->
2270:                                Compare.st_atime b#st_atime a#st_atime)
2271:                         | "st_mtime" ->
2272:                             (fun a b ->
2273:                                Compare.st_mtime b#st_mtime a#st_mtime)
2274:                         | "st_ctime" ->
2275:                             (fun a b ->
2276:                                Compare.st_ctime b#st_ctime a#st_ctime)
2277:                         | s -> raise (Invalid_field s)
2278:                         end
2279:                     | `Custom f -> f)
2280:                    l)
2281:             let compare_labels l =
2282:               Run_col.Run_col_main.multi_compare
2283:                 (List.map
2284:                    (function
2285:                       `Up s ->
2286:                         begin match s with
2287:                           "st_dev" ->
2288:                             (fun a b -> Compare.st_dev a#st_dev b#st_dev)
2289:                         | "st_ino" ->
2290:                             (fun a b -> Compare.st_ino a#st_ino b#st_ino)
2291:                         | "st_kind" ->
2292:                             (fun a b -> Compare.st_kind a#st_kind b#st_kind)
2293:                         | "st_perm" ->
2294:                             (fun a b -> Compare.st_perm a#st_perm b#st_perm)
2295:                         | "st_nlink" ->
2296:                             (fun a b ->
2297:                                Compare.st_nlink a#st_nlink b#st_nlink)
2298:                         | "st_uid" ->
2299:                             (fun a b -> Compare.st_uid a#st_uid b#st_uid)
2300:                         | "st_gid" ->
2301:                             (fun a b -> Compare.st_gid a#st_gid b#st_gid)
2302:                         | "st_rdev" ->
2303:                             (fun a b -> Compare.st_rdev a#st_rdev b#st_rdev)
2304:                         | "st_size" ->
2305:                             (fun a b -> Compare.st_size a#st_size b#st_size)
2306:                         | "st_atime" ->
2307:                             (fun a b ->
2308:                                Compare.st_atime a#st_atime b#st_atime)
2309:                         | "st_mtime" ->
2310:                             (fun a b ->
2311:                                Compare.st_mtime a#st_mtime b#st_mtime)
2312:                         | "st_ctime" ->
2313:                             (fun a b ->
2314:                                Compare.st_ctime a#st_ctime b#st_ctime)
2315:                         | s -> raise (Invalid_label s)
2316:                         end
2317:                     | `Down s ->
2318:                         begin match s with
2319:                           "st_dev" ->
2320:                             (fun a b -> Compare.st_dev b#st_dev a#st_dev)
2321:                         | "st_ino" ->
2322:                             (fun a b -> Compare.st_ino b#st_ino a#st_ino)
2323:                         | "st_kind" ->
2324:                             (fun a b -> Compare.st_kind b#st_kind a#st_kind)
2325:                         | "st_perm" ->
2326:                             (fun a b -> Compare.st_perm b#st_perm a#st_perm)
2327:                         | "st_nlink" ->
2328:                             (fun a b ->
2329:                                Compare.st_nlink b#st_nlink a#st_nlink)
2330:                         | "st_uid" ->
2331:                             (fun a b -> Compare.st_uid b#st_uid a#st_uid)
2332:                         | "st_gid" ->
2333:                             (fun a b -> Compare.st_gid b#st_gid a#st_gid)
2334:                         | "st_rdev" ->
2335:                             (fun a b -> Compare.st_rdev b#st_rdev a#st_rdev)
2336:                         | "st_size" ->
2337:                             (fun a b -> Compare.st_size b#st_size a#st_size)
2338:                         | "st_atime" ->
2339:                             (fun a b ->
2340:                                Compare.st_atime b#st_atime a#st_atime)
2341:                         | "st_mtime" ->
2342:                             (fun a b ->
2343:                                Compare.st_mtime b#st_mtime a#st_mtime)
2344:                         | "st_ctime" ->
2345:                             (fun a b ->
2346:                                Compare.st_ctime b#st_ctime a#st_ctime)
2347:                         | s -> raise (Invalid_label s)
2348:                         end
2349:                     | `Custom f -> f)
2350:                    l)
2351:           end
2352:       end
2353:     let print_list l = print_endline (String.concat " " l)
2354:     let print_row (file, stats) =
2355:       print_list (file :: Array.to_list (Stats.to_array stats))
2356:     let dir =
2357:       match Sys.argv with
2358:         [| _; dir |] -> dir
2359:       | _ -> Sys.getcwd ()
2360:     let files = Array.to_list (Sys.readdir dir)
2361:     let stats =
2362:       List.map (fun file -> file, stat (Filename.concat dir file)) files
2363:     let cmp = Stats.compare_fields [`Up "st_kind"; `Down "st_size"]
2364:     let sort l =
2365:       List.sort
2366:         (fun (file1, stat1) (file2, stat2) ->
2367:            let c = cmp stat1 stat2 in
2368:            if c <> 0 then c else String.compare file1 file2)
2369:         l
2370:     let _ =
2371:       print_list ("file" :: Array.to_list Stats.fields);
2372:       List.iter print_row (sort stats)
2373:   end