Note:

You are viewing a development version of the library. Goto the latest version.

let oasissysbundle_ml = 
  "module OASISGettext = struct\n# 22 \"src/oasis/OASISGettext.ml\"\n\n\n\  let ns_ str =\n\    str\n\n\n\  let s_ str =\n\    str\n\n\n\  let f_ (str: ('a, 'b, 'c, 'd) format4) =\n\    str\n\n\n\  let fn_ fmt1 fmt2 n =\n\    if n = 1 then\n\      fmt1^^\"\"\n\    else\n\      fmt2^^\"\"\n\n\n\  let init =\n\    []\n\n\nend\n\nmodule OASISContext = struct\n# 22 \"src/oasis/OASISContext.ml\"\n\n\n\  open OASISGettext\n\n\n\  type level =\n\    [ `Debug\n\    | `Info\n\    | `Warning\n\    | `Error]\n\n\n\  type t =\n\    {\n\      (* TODO: replace this by a proplist. *)\n\      quiet:                 bool;\n\      info:                  bool;\n\      debug:                 bool;\n\      ignore_plugins:        bool;\n\      ignore_unknown_fields: bool;\n\      printf:                level -> string -> unit;\n\    }\n\n\n\  let printf lvl str =\n\    let beg =\n\      match lvl with\n\        | `Error -> s_ \"E: \"\n\        | `Warning -> s_ \"W: \"\n\        | `Info  -> s_ \"I: \"\n\        | `Debug -> s_ \"D: \"\n\    in\n\      prerr_endline (beg^str)\n\n\n\  let default =\n\    ref\n\      {\n\        quiet                 = false;\n\        info                  = false;\n\        debug                 = false;\n\        ignore_plugins        = false;\n\        ignore_unknown_fields = false;\n\        printf                = printf;\n\      }\n\n\n\  let quiet =\n\    {!default with quiet = true}\n\n\n\  let fspecs () =\n\    (* TODO: don't act on default. *)\n\    let ignore_plugins = ref false in\n\    [\"-quiet\",\n\     Arg.Unit (fun () -> default := {!default with quiet = true}),\n\     s_ \" Run quietly\";\n\n\     \"-info\",\n\     Arg.Unit (fun () -> default := {!default with info = true}),\n\     s_ \" Display information message\";\n\n\n\     \"-debug\",\n\     Arg.Unit (fun () -> default := {!default with debug = true}),\n\     s_ \" Output debug message\";\n\n\     \"-ignore-plugins\",\n\     Arg.Set ignore_plugins,\n\     s_ \" Ignore plugin's field.\";\n\n\     \"-C\",\n\     (* TODO: remove this chdir. *)\n\     Arg.String (fun str -> Sys.chdir str),\n\     s_ \"dir Change directory before running.\"],\n\    fun () -> {!default with ignore_plugins = !ignore_plugins}\nend\n\nmodule OASISString = struct\n# 22 \"src/oasis/OASISString.ml\"\n\n\n\  (** Various string utilities.\n\n\      Mostly inspired by extlib and batteries ExtString and BatString libraries.\n\n\      @author Sylvain Le Gall\n\    *)\n\n\n\  let nsplitf str f =\n\    if str = \"\" then\n\      []\n\    else\n\      let buf = Buffer.create 13 in\n\      let lst = ref [] in\n\      let push () =\n\        lst := Buffer.contents buf :: !lst;\n\        Buffer.clear buf\n\      in\n\      let str_len = String.length str in\n\        for i = 0 to str_len - 1 do\n\          if f str.[i] then\n\            push ()\n\          else\n\            Buffer.add_char buf str.[i]\n\        done;\n\        push ();\n\        List.rev !lst\n\n\n\  (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the\n\      separator.\n\    *)\n\  let nsplit str c =\n\    nsplitf str ((=) c)\n\n\n\  let find ~what ?(offset=0) str =\n\    let what_idx = ref 0 in\n\    let str_idx = ref offset in\n\      while !str_idx < String.length str &&\n\            !what_idx < String.length what do\n\        if str.[!str_idx] = what.[!what_idx] then\n\          incr what_idx\n\        else\n\          what_idx := 0;\n\        incr str_idx\n\      done;\n\      if !what_idx <> String.length what then\n\        raise Not_found\n\      else\n\        !str_idx - !what_idx\n\n\n\  let sub_start str len =\n\    let str_len = String.length str in\n\    if len >= str_len then\n\      \"\"\n\    else\n\      String.sub str len (str_len - len)\n\n\n\  let sub_end ?(offset=0) str len =\n\    let str_len = String.length str in\n\    if len >= str_len then\n\      \"\"\n\    else\n\      String.sub str 0 (str_len - len)\n\n\n\  let starts_with ~what ?(offset=0) str =\n\    let what_idx = ref 0 in\n\    let str_idx = ref offset in\n\    let ok = ref true in\n\      while !ok &&\n\            !str_idx < String.length str &&\n\            !what_idx < String.length what do\n\        if str.[!str_idx] = what.[!what_idx] then\n\          incr what_idx\n\        else\n\          ok := false;\n\        incr str_idx\n\      done;\n\      if !what_idx = String.length what then\n\        true\n\      else\n\        false\n\n\n\  let strip_starts_with ~what str =\n\    if starts_with ~what str then\n\      sub_start str (String.length what)\n\    else\n\      raise Not_found\n\n\n\  let ends_with ~what ?(offset=0) str =\n\    let what_idx = ref ((String.length what) - 1) in\n\    let str_idx = ref ((String.length str) - 1) in\n\    let ok = ref true in\n\      while !ok &&\n\            offset <= !str_idx &&\n\            0 <= !what_idx do\n\        if str.[!str_idx] = what.[!what_idx] then\n\          decr what_idx\n\        else\n\          ok := false;\n\        decr str_idx\n\      done;\n\      if !what_idx = -1 then\n\        true\n\      else\n\        false\n\n\n\  let strip_ends_with ~what str =\n\    if ends_with ~what str then\n\      sub_end str (String.length what)\n\    else\n\      raise Not_found\n\n\n\  let replace_chars f s =\n\    let buf = Buffer.create (String.length s) in\n\    String.iter (fun c -> Buffer.add_char buf (f c)) s;\n\    Buffer.contents buf\n\n\nend\n\nmodule OASISUtils = struct\n# 22 \"src/oasis/OASISUtils.ml\"\n\n\n\  open OASISGettext\n\n\n\  module MapExt =\n\  struct\n\    module type S =\n\    sig\n\      include Map.S\n\      val add_list: 'a t -> (key * 'a) list -> 'a t\n\      val of_list: (key * 'a) list -> 'a t\n\      val to_list: 'a t -> (key * 'a) list\n\    end\n\n\    module Make (Ord: Map.OrderedType) =\n\    struct\n\      include Map.Make(Ord)\n\n\      let rec add_list t =\n\        function\n\          | (k, v) :: tl -> add_list (add k v t) tl\n\          | [] -> t\n\n\      let of_list lst = add_list empty lst\n\n\      let to_list t = fold (fun k v acc -> (k, v) :: acc) t []\n\    end\n\  end\n\n\n\  module MapString = MapExt.Make(String)\n\n\n\  module SetExt  =\n\  struct\n\    module type S =\n\    sig\n\      include Set.S\n\      val add_list: t -> elt list -> t\n\      val of_list: elt list -> t\n\      val to_list: t -> elt list\n\    end\n\n\    module Make (Ord: Set.OrderedType) =\n\    struct\n\      include Set.Make(Ord)\n\n\      let rec add_list t =\n\        function\n\          | e :: tl -> add_list (add e t) tl\n\          | [] -> t\n\n\      let of_list lst = add_list empty lst\n\n\      let to_list = elements\n\    end\n\  end\n\n\n\  module SetString = SetExt.Make(String)\n\n\n\  let compare_csl s1 s2 =\n\    String.compare (String.lowercase s1) (String.lowercase s2)\n\n\n\  module HashStringCsl =\n\    Hashtbl.Make\n\      (struct\n\         type t = string\n\n\         let equal s1 s2 =\n\             (String.lowercase s1) = (String.lowercase s2)\n\n\         let hash s =\n\           Hashtbl.hash (String.lowercase s)\n\       end)\n\n\  module SetStringCsl =\n\    SetExt.Make\n\      (struct\n\         type t = string\n\         let compare = compare_csl\n\       end)\n\n\n\  let varname_of_string ?(hyphen='_') s =\n\    if String.length s = 0 then\n\      begin\n\        invalid_arg \"varname_of_string\"\n\      end\n\    else\n\      begin\n\        let buf =\n\          OASISString.replace_chars\n\            (fun c ->\n\               if ('a' <= c && c <= 'z')\n\                 ||\n\                  ('A' <= c && c <= 'Z')\n\                 ||\n\                  ('0' <= c && c <= '9') then\n\                 c\n\               else\n\                 hyphen)\n\            s;\n\        in\n\        let buf =\n\          (* Start with a _ if digit *)\n\          if '0' <= s.[0] && s.[0] <= '9' then\n\            \"_\"^buf\n\          else\n\            buf\n\        in\n\          String.lowercase buf\n\      end\n\n\n\  let varname_concat ?(hyphen='_') p s =\n\    let what = String.make 1 hyphen in\n\    let p =\n\      try\n\        OASISString.strip_ends_with ~what p\n\      with Not_found ->\n\        p\n\    in\n\    let s =\n\      try\n\        OASISString.strip_starts_with ~what s\n\      with Not_found ->\n\        s\n\    in\n\      p^what^s\n\n\n\  let is_varname str =\n\    str = varname_of_string str\n\n\n\  let failwithf fmt = Printf.ksprintf failwith fmt\n\n\nend\n\nmodule PropList = struct\n# 22 \"src/oasis/PropList.ml\"\n\n\n\  open OASISGettext\n\n\n\  type name = string\n\n\n\  exception Not_set of name * string option\n\  exception No_printer of name\n\  exception Unknown_field of name * name\n\n\n\  let () =\n\    Printexc.register_printer\n\      (function\n\         | Not_set (nm, Some rsn) ->\n\             Some\n\               (Printf.sprintf (f_ \"Field '%s' is not set: %s\") nm rsn)\n\         | Not_set (nm, None) ->\n\             Some\n\               (Printf.sprintf (f_ \"Field '%s' is not set\") nm)\n\         | No_printer nm ->\n\             Some\n\               (Printf.sprintf (f_ \"No default printer for value %s\") nm)\n\         | Unknown_field (nm, schm) ->\n\             Some\n\               (Printf.sprintf\n\                  (f_ \"Field %s is not defined in schema %s\") nm schm)\n\         | _ ->\n\             None)\n\n\n\  module Data =\n\  struct\n\    type t =\n\        (name, unit -> unit) Hashtbl.t\n\n\    let create () =\n\      Hashtbl.create 13\n\n\    let clear t =\n\      Hashtbl.clear t\n\n\n# 78 \"src/oasis/PropList.ml\"\n\  end\n\n\n\  module Schema =\n\  struct\n\    type ('ctxt, 'extra) value =\n\        {\n\          get:   Data.t -> string;\n\          set:   Data.t -> ?context:'ctxt -> string -> unit;\n\          help:  (unit -> string) option;\n\          extra: 'extra;\n\        }\n\n\    type ('ctxt, 'extra) t =\n\        {\n\          name:      name;\n\          fields:    (name, ('ctxt, 'extra) value) Hashtbl.t;\n\          order:     name Queue.t;\n\          name_norm: string -> string;\n\        }\n\n\    let create ?(case_insensitive=false) nm =\n\      {\n\        name      = nm;\n\        fields    = Hashtbl.create 13;\n\        order     = Queue.create ();\n\        name_norm =\n\          (if case_insensitive then\n\             String.lowercase\n\           else\n\             fun s -> s);\n\      }\n\n\    let add t nm set get extra help =\n\      let key =\n\        t.name_norm nm\n\      in\n\n\        if Hashtbl.mem t.fields key then\n\          failwith\n\            (Printf.sprintf\n\               (f_ \"Field '%s' is already defined in schema '%s'\")\n\               nm t.name);\n\        Hashtbl.add\n\          t.fields\n\          key\n\          {\n\            set   = set;\n\            get   = get;\n\            help  = help;\n\            extra = extra;\n\          };\n\        Queue.add nm t.order\n\n\    let mem t nm =\n\      Hashtbl.mem t.fields nm\n\n\    let find t nm =\n\      try\n\        Hashtbl.find t.fields (t.name_norm nm)\n\      with Not_found ->\n\        raise (Unknown_field (nm, t.name))\n\n\    let get t data nm =\n\      (find t nm).get data\n\n\    let set t data nm ?context x =\n\      (find t nm).set\n\        data\n\        ?context\n\        x\n\n\    let fold f acc t =\n\      Queue.fold\n\        (fun acc k ->\n\           let v =\n\             find t k\n\           in\n\             f acc k v.extra v.help)\n\        acc\n\        t.order\n\n\    let iter f t =\n\      fold\n\        (fun () -> f)\n\        ()\n\        t\n\n\    let name t =\n\      t.name\n\  end\n\n\n\  module Field =\n\  struct\n\    type ('ctxt, 'value, 'extra) t =\n\        {\n\          set:    Data.t -> ?context:'ctxt -> 'value -> unit;\n\          get:    Data.t -> 'value;\n\          sets:   Data.t -> ?context:'ctxt -> string -> unit;\n\          gets:   Data.t -> string;\n\          help:   (unit -> string) option;\n\          extra:  'extra;\n\        }\n\n\    let new_id =\n\      let last_id =\n\        ref 0\n\      in\n\        fun () -> incr last_id; !last_id\n\n\    let create ?schema ?name ?parse ?print ?default ?update ?help extra =\n\      (* Default value container *)\n\      let v =\n\        ref None\n\      in\n\n\      (* If name is not given, create unique one *)\n\      let nm =\n\        match name with\n\          | Some s -> s\n\          | None -> Printf.sprintf \"_anon_%d\" (new_id ())\n\      in\n\n\      (* Last chance to get a value: the default *)\n\      let default () =\n\        match default with\n\          | Some d -> d\n\          | None -> raise (Not_set (nm, Some (s_ \"no default value\")))\n\      in\n\n\      (* Get data *)\n\      let get data =\n\        (* Get value *)\n\        try\n\          (Hashtbl.find data nm) ();\n\          match !v with\n\            | Some x -> x\n\            | None -> default ()\n\        with Not_found ->\n\          default ()\n\      in\n\n\      (* Set data *)\n\      let set data ?context x =\n\        let x =\n\          match update with\n\            | Some f ->\n\                begin\n\                  try\n\                    f ?context (get data) x\n\                  with Not_set _ ->\n\                    x\n\                end\n\            | None ->\n\                x\n\        in\n\          Hashtbl.replace\n\            data\n\            nm\n\            (fun () -> v := Some x)\n\      in\n\n\      (* Parse string value, if possible *)\n\      let parse =\n\        match parse with\n\          | Some f ->\n\              f\n\          | None ->\n\              fun ?context s ->\n\                failwith\n\                  (Printf.sprintf\n\                     (f_ \"Cannot parse field '%s' when setting value %S\")\n\                     nm\n\                     s)\n\      in\n\n\      (* Set data, from string *)\n\      let sets data ?context s =\n\        set ?context data (parse ?context s)\n\      in\n\n\      (* Output value as string, if possible *)\n\      let print =\n\        match print with\n\          | Some f ->\n\              f\n\          | None ->\n\              fun _ -> raise (No_printer nm)\n\      in\n\n\      (* Get data, as a string *)\n\      let gets data =\n\        print (get data)\n\      in\n\n\        begin\n\          match schema with\n\            | Some t ->\n\                Schema.add t nm sets gets extra help\n\            | None ->\n\                ()\n\        end;\n\n\        {\n\          set   = set;\n\          get   = get;\n\          sets  = sets;\n\          gets  = gets;\n\          help  = help;\n\          extra = extra;\n\        }\n\n\    let fset data t ?context x =\n\      t.set data ?context x\n\n\    let fget data t =\n\      t.get data\n\n\    let fsets data t ?context s =\n\      t.sets data ?context s\n\n\    let fgets data t =\n\      t.gets data\n\  end\n\n\n\  module FieldRO =\n\  struct\n\    let create ?schema ?name ?parse ?print ?default ?update ?help extra =\n\      let fld =\n\        Field.create ?schema ?name ?parse ?print ?default ?update ?help extra\n\      in\n\        fun data -> Field.fget data fld\n\  end\nend\n\nmodule OASISMessage = struct\n# 22 \"src/oasis/OASISMessage.ml\"\n\n\n\  open OASISGettext\n\  open OASISContext\n\n\n\  let generic_message ~ctxt lvl fmt =\n\    let cond =\n\      if ctxt.quiet then\n\        false\n\      else\n\        match lvl with\n\          | `Debug -> ctxt.debug\n\          | `Info  -> ctxt.info\n\          | _ -> true\n\    in\n\      Printf.ksprintf\n\        (fun str ->\n\           if cond then\n\             begin\n\               ctxt.printf lvl str\n\             end)\n\        fmt\n\n\n\  let debug ~ctxt fmt =\n\    generic_message ~ctxt `Debug fmt\n\n\n\  let info ~ctxt fmt =\n\    generic_message ~ctxt `Info fmt\n\n\n\  let warning ~ctxt fmt =\n\    generic_message ~ctxt `Warning fmt\n\n\n\  let error ~ctxt fmt =\n\    generic_message ~ctxt `Error fmt\n\nend\n\nmodule OASISVersion = struct\n# 22 \"src/oasis/OASISVersion.ml\"\n\n\n\  open OASISGettext\n\n\n\n\n\n\  type s = string\n\n\n\  type t = string\n\n\n\  type comparator =\n\    | VGreater of t\n\    | VGreaterEqual of t\n\    | VEqual of t\n\    | VLesser of t\n\    | VLesserEqual of t\n\    | VOr of  comparator * comparator\n\    | VAnd of comparator * comparator\n\n\n\n\  (* Range of allowed characters *)\n\  let is_digit c =\n\    '0' <= c && c <= '9'\n\n\n\  let is_alpha c =\n\    ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')\n\n\n\  let is_special =\n\    function\n\      | '.' | '+' | '-' | '~' -> true\n\      | _ -> false\n\n\n\  let rec version_compare v1 v2 =\n\    if v1 <> \"\" || v2 <> \"\" then\n\      begin\n\        (* Compare ascii string, using special meaning for version\n\         * related char\n\         *)\n\        let val_ascii c =\n\          if c = '~' then -1\n\          else if is_digit c then 0\n\          else if c = '\\000' then 0\n\          else if is_alpha c then Char.code c\n\          else (Char.code c) + 256\n\        in\n\n\        let len1 = String.length v1 in\n\        let len2 = String.length v2 in\n\n\        let p = ref 0 in\n\n\        (** Compare ascii part *)\n\        let compare_vascii () =\n\          let cmp = ref 0 in\n\          while !cmp = 0 &&\n\                !p < len1 && !p < len2 &&\n\                not (is_digit v1.[!p] && is_digit v2.[!p]) do\n\            cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);\n\            incr p\n\          done;\n\          if !cmp = 0 && !p < len1 && !p = len2 then\n\            val_ascii v1.[!p]\n\          else if !cmp = 0 && !p = len1 && !p < len2 then\n\            - (val_ascii v2.[!p])\n\          else\n\            !cmp\n\        in\n\n\        (** Compare digit part *)\n\        let compare_digit () =\n\          let extract_int v p =\n\            let start_p = !p in\n\              while !p < String.length v && is_digit v.[!p] do\n\                incr p\n\              done;\n\              let substr =\n\                String.sub v !p ((String.length v) - !p)\n\              in\n\              let res =\n\                match String.sub v start_p (!p - start_p) with\n\                  | \"\" -> 0\n\                  | s -> int_of_string s\n\              in\n\                res, substr\n\          in\n\          let i1, tl1 = extract_int v1 (ref !p) in\n\          let i2, tl2 = extract_int v2 (ref !p) in\n\            i1 - i2, tl1, tl2\n\        in\n\n\          match compare_vascii () with\n\            | 0 ->\n\                begin\n\                  match compare_digit () with\n\                    | 0, tl1, tl2 ->\n\                        if tl1 <> \"\" && is_digit tl1.[0] then\n\                          1\n\                        else if tl2 <> \"\" && is_digit tl2.[0] then\n\                          -1\n\                        else\n\                          version_compare tl1 tl2\n\                    | n, _, _ ->\n\                        n\n\                end\n\            | n ->\n\                n\n\      end\n\    else\n\      begin\n\        0\n\      end\n\n\n\  let version_of_string str = str\n\n\n\  let string_of_version t = t\n\n\n\  let version_compare_string s1 s2 =\n\    version_compare (version_of_string s1) (version_of_string s2)\n\n\n\  let chop t =\n\    try\n\      let pos =\n\        String.rindex t '.'\n\      in\n\        String.sub t 0 pos\n\    with Not_found ->\n\      t\n\n\n\  let rec comparator_apply v op =\n\    match op with\n\      | VGreater cv ->\n\          (version_compare v cv) > 0\n\      | VGreaterEqual cv ->\n\          (version_compare v cv) >= 0\n\      | VLesser cv ->\n\          (version_compare v cv) < 0\n\      | VLesserEqual cv ->\n\          (version_compare v cv) <= 0\n\      | VEqual cv ->\n\          (version_compare v cv) = 0\n\      | VOr (op1, op2) ->\n\          (comparator_apply v op1) || (comparator_apply v op2)\n\      | VAnd (op1, op2) ->\n\          (comparator_apply v op1) && (comparator_apply v op2)\n\n\n\  let rec string_of_comparator =\n\    function\n\      | VGreater v  -> \"> \"^(string_of_version v)\n\      | VEqual v    -> \"= \"^(string_of_version v)\n\      | VLesser v   -> \"< \"^(string_of_version v)\n\      | VGreaterEqual v -> \">= \"^(string_of_version v)\n\      | VLesserEqual v  -> \"<= \"^(string_of_version v)\n\      | VOr (c1, c2)  ->\n\          (string_of_comparator c1)^\" || \"^(string_of_comparator c2)\n\      | VAnd (c1, c2) ->\n\          (string_of_comparator c1)^\" && \"^(string_of_comparator c2)\n\n\n\  let rec varname_of_comparator =\n\    let concat p v =\n\      OASISUtils.varname_concat\n\        p\n\        (OASISUtils.varname_of_string\n\           (string_of_version v))\n\    in\n\      function\n\        | VGreater v -> concat \"gt\" v\n\        | VLesser v  -> concat \"lt\" v\n\        | VEqual v   -> concat \"eq\" v\n\        | VGreaterEqual v -> concat \"ge\" v\n\        | VLesserEqual v  -> concat \"le\" v\n\        | VOr (c1, c2) ->\n\            (varname_of_comparator c1)^\"_or_\"^(varname_of_comparator c2)\n\        | VAnd (c1, c2) ->\n\            (varname_of_comparator c1)^\"_and_\"^(varname_of_comparator c2)\n\n\n\  let rec comparator_ge v' =\n\    let cmp v = version_compare v v' >= 0 in\n\    function\n\      | VEqual v\n\      | VGreaterEqual v\n\      | VGreater v -> cmp v\n\      | VLesserEqual _\n\      | VLesser _ -> false\n\      | VOr (c1, c2) -> comparator_ge v' c1 || comparator_ge v' c2\n\      | VAnd (c1, c2) -> comparator_ge v' c1 && comparator_ge v' c2\n\n\nend\n\nmodule OASISExpr = struct\n# 22 \"src/oasis/OASISExpr.ml\"\n\n\n\n\n\n\  open OASISGettext\n\n\n\  type test = string\n\n\n\  type flag = string\n\n\n\  type t =\n\    | EBool of bool\n\    | ENot of t\n\    | EAnd of t * t\n\    | EOr of t * t\n\    | EFlag of flag\n\    | ETest of test * string\n\n\n\n\  type 'a choices = (t * 'a) list\n\n\n\  let eval var_get t =\n\    let rec eval' =\n\      function\n\        | EBool b ->\n\            b\n\n\        | ENot e ->\n\            not (eval' e)\n\n\        | EAnd (e1, e2) ->\n\            (eval' e1) && (eval' e2)\n\n\        | EOr (e1, e2) ->\n\            (eval' e1) || (eval' e2)\n\n\        | EFlag nm ->\n\            let v =\n\              var_get nm\n\            in\n\              assert(v = \"true\" || v = \"false\");\n\              (v = \"true\")\n\n\        | ETest (nm, vl) ->\n\            let v =\n\              var_get nm\n\            in\n\              (v = vl)\n\    in\n\      eval' t\n\n\n\  let choose ?printer ?name var_get lst =\n\    let rec choose_aux =\n\      function\n\        | (cond, vl) :: tl ->\n\            if eval var_get cond then\n\              vl\n\            else\n\              choose_aux tl\n\        | [] ->\n\            let str_lst =\n\              if lst = [] then\n\                s_ \"<empty>\"\n\              else\n\                String.concat\n\                  (s_ \", \")\n\                  (List.map\n\                     (fun (cond, vl) ->\n\                        match printer with\n\                          | Some p -> p vl\n\                          | None -> s_ \"<no printer>\")\n\                     lst)\n\            in\n\              match name with\n\                | Some nm ->\n\                    failwith\n\                      (Printf.sprintf\n\                         (f_ \"No result for the choice list '%s': %s\")\n\                         nm str_lst)\n\                | None ->\n\                    failwith\n\                      (Printf.sprintf\n\                         (f_ \"No result for a choice list: %s\")\n\                         str_lst)\n\    in\n\      choose_aux (List.rev lst)\n\n\nend\n\nmodule OASISUnixPath = struct\n# 22 \"src/oasis/OASISUnixPath.ml\"\n\n\n\  type unix_filename = string\n\  type unix_dirname = string\n\n\n\  type host_filename = string\n\  type host_dirname = string\n\n\n\  let current_dir_name = \".\"\n\n\n\  let parent_dir_name = \"..\"\n\n\n\  let is_current_dir fn =\n\    fn = current_dir_name || fn = \"\"\n\n\n\  let concat f1 f2 =\n\    if is_current_dir f1 then\n\      f2\n\    else\n\      let f1' =\n\        try OASISString.strip_ends_with ~what:\"/\" f1 with Not_found -> f1\n\      in\n\        f1'^\"/\"^f2\n\n\n\  let make =\n\    function\n\      | hd :: tl ->\n\          List.fold_left\n\            (fun f p -> concat f p)\n\            hd\n\            tl\n\      | [] ->\n\          invalid_arg \"OASISUnixPath.make\"\n\n\n\  let dirname f =\n\    try\n\      String.sub f 0 (String.rindex f '/')\n\    with Not_found ->\n\      current_dir_name\n\n\n\  let basename f =\n\    try\n\      let pos_start =\n\        (String.rindex f '/') + 1\n\      in\n\        String.sub f pos_start ((String.length f) - pos_start)\n\    with Not_found ->\n\      f\n\n\n\  let chop_extension f =\n\    try\n\      let last_dot =\n\        String.rindex f '.'\n\      in\n\      let sub =\n\        String.sub f 0 last_dot\n\      in\n\        try\n\          let last_slash =\n\            String.rindex f '/'\n\          in\n\            if last_slash < last_dot then\n\              sub\n\            else\n\              f\n\        with Not_found ->\n\          sub\n\n\    with Not_found ->\n\      f\n\n\n\  let capitalize_file f =\n\    let dir = dirname f in\n\    let base = basename f in\n\    concat dir (String.capitalize base)\n\n\n\  let uncapitalize_file f =\n\    let dir = dirname f in\n\    let base = basename f in\n\    concat dir (String.uncapitalize base)\n\n\nend\n\nmodule OASISHostPath = struct\n# 22 \"src/oasis/OASISHostPath.ml\"\n\n\n\  open Filename\n\n\n\  module Unix = OASISUnixPath\n\n\n\  let make =\n\    function\n\      | [] ->\n\          invalid_arg \"OASISHostPath.make\"\n\      | hd :: tl ->\n\          List.fold_left Filename.concat hd tl\n\n\n\  let of_unix ufn =\n\    if Sys.os_type = \"Unix\" then\n\      ufn\n\    else\n\      make\n\        (List.map\n\           (fun p ->\n\              if p = Unix.current_dir_name then\n\                current_dir_name\n\              else if p = Unix.parent_dir_name then\n\                parent_dir_name\n\              else\n\                p)\n\           (OASISString.nsplit ufn '/'))\n\n\nend\n\nmodule OASISExec = struct\n# 22 \"src/oasis/OASISExec.ml\"\n\n\n\  open OASISGettext\n\  open OASISUtils\n\  open OASISMessage\n\n\n\  (* TODO: I don't like this quote, it is there because $(rm) foo expands to\n\   * 'rm -f' foo...\n\   *)\n\  let run ~ctxt ?f_exit_code ?(quote=true) cmd args =\n\    let cmd =\n\      if quote then\n\        if Sys.os_type = \"Win32\" then\n\          if String.contains cmd ' ' then\n\            (* Double the 1st double quote... win32... sigh *)\n\            \"\\\"\"^(Filename.quote cmd)\n\          else\n\            cmd\n\        else\n\          Filename.quote cmd\n\      else\n\        cmd\n\    in\n\    let cmdline =\n\      String.concat \" \" (cmd :: args)\n\    in\n\      info ~ctxt (f_ \"Running command '%s'\") cmdline;\n\      match f_exit_code, Sys.command cmdline with\n\        | None, 0 -> ()\n\        | None, i ->\n\            failwithf\n\              (f_ \"Command '%s' terminated with error code %d\")\n\              cmdline i\n\        | Some f, i ->\n\            f i\n\n\n\  let run_read_output ~ctxt ?f_exit_code cmd args =\n\    let fn =\n\      Filename.temp_file \"oasis-\" \".txt\"\n\    in\n\      try\n\        begin\n\          let () =\n\            run ~ctxt ?f_exit_code cmd (args @ [\">\"; Filename.quote fn])\n\          in\n\          let chn =\n\            open_in fn\n\          in\n\          let routput =\n\            ref []\n\          in\n\            begin\n\              try\n\                while true do\n\                  routput := (input_line chn) :: !routput\n\                done\n\              with End_of_file ->\n\                ()\n\            end;\n\            close_in chn;\n\            Sys.remove fn;\n\            List.rev !routput\n\        end\n\      with e ->\n\        (try Sys.remove fn with _ -> ());\n\        raise e\n\n\n\  let run_read_one_line ~ctxt ?f_exit_code cmd args =\n\    match run_read_output ~ctxt ?f_exit_code cmd args with\n\      | [fst] ->\n\          fst\n\      | lst ->\n\          failwithf\n\            (f_ \"Command return unexpected output %S\")\n\            (String.concat \"\\n\" lst)\nend\n\nmodule OASISFileUtil = struct\n# 22 \"src/oasis/OASISFileUtil.ml\"\n\n\n\  open OASISGettext\n\n\n\  let file_exists_case fn =\n\    let dirname = Filename.dirname fn in\n\    let basename = Filename.basename fn in\n\      if Sys.file_exists dirname then\n\        if basename = Filename.current_dir_name then\n\          true\n\        else\n\          List.mem\n\            basename\n\            (Array.to_list (Sys.readdir dirname))\n\      else\n\        false\n\n\n\  let find_file ?(case_sensitive=true) paths exts =\n\n\    (* Cardinal product of two list *)\n\    let ( * ) lst1 lst2 =\n\      List.flatten\n\        (List.map\n\           (fun a ->\n\              List.map\n\                (fun b -> a, b)\n\                lst2)\n\           lst1)\n\    in\n\n\    let rec combined_paths lst =\n\      match lst with\n\        | p1 :: p2 :: tl ->\n\            let acc =\n\              (List.map\n\                 (fun (a, b) -> Filename.concat a b)\n\                 (p1 * p2))\n\            in\n\              combined_paths (acc :: tl)\n\        | [e] ->\n\            e\n\        | [] ->\n\            []\n\    in\n\n\    let alternatives =\n\      List.map\n\        (fun (p, e) ->\n\           if String.length e > 0 && e.[0] <> '.' then\n\             p ^ \".\" ^ e\n\           else\n\             p ^ e)\n\        ((combined_paths paths) * exts)\n\    in\n\      List.find (fun file ->\n\        (if case_sensitive then\n\           file_exists_case file\n\         else\n\           Sys.file_exists file)\n\        && not (Sys.is_directory file)\n\      ) alternatives\n\n\n\  let which ~ctxt prg =\n\    let path_sep =\n\      match Sys.os_type with\n\        | \"Win32\" ->\n\            ';'\n\        | _ ->\n\            ':'\n\    in\n\    let path_lst = OASISString.nsplit (Sys.getenv \"PATH\") path_sep in\n\    let exec_ext =\n\      match Sys.os_type with\n\        | \"Win32\" ->\n\            \"\" :: (OASISString.nsplit (Sys.getenv \"PATHEXT\") path_sep)\n\        | _ ->\n\            [\"\"]\n\    in\n\      find_file ~case_sensitive:false [path_lst; [prg]] exec_ext\n\n\n\  (**/**)\n\  let rec fix_dir dn =\n\    (* Windows hack because Sys.file_exists \"src\\\\\" = false when\n\     * Sys.file_exists \"src\" = true\n\     *)\n\    let ln =\n\      String.length dn\n\    in\n\      if Sys.os_type = \"Win32\" && ln > 0 && dn.[ln - 1] = '\\\\' then\n\        fix_dir (String.sub dn 0 (ln - 1))\n\      else\n\        dn\n\n\n\  let q = Filename.quote\n\  (**/**)\n\n\n\  let cp ~ctxt ?(recurse=false) src tgt =\n\    if recurse then\n\      match Sys.os_type with\n\        | \"Win32\" ->\n\            OASISExec.run ~ctxt\n\              \"xcopy\" [q src; q tgt; \"/E\"]\n\        | _ ->\n\            OASISExec.run ~ctxt\n\              \"cp\" [\"-r\"; q src; q tgt]\n\    else\n\      OASISExec.run ~ctxt\n\        (match Sys.os_type with\n\         | \"Win32\" -> \"copy\"\n\         | _ -> \"cp\")\n\        [q src; q tgt]\n\n\n\  let mkdir ~ctxt tgt =\n\    OASISExec.run ~ctxt\n\      (match Sys.os_type with\n\         | \"Win32\" -> \"md\"\n\         | _ -> \"mkdir\")\n\      [q tgt]\n\n\n\  let rec mkdir_parent ~ctxt f tgt =\n\    let tgt =\n\      fix_dir tgt\n\    in\n\      if Sys.file_exists tgt then\n\        begin\n\          if not (Sys.is_directory tgt) then\n\            OASISUtils.failwithf\n\              (f_ \"Cannot create directory '%s', a file of the same name already \\\n\                   exists\")\n\              tgt\n\        end\n\      else\n\        begin\n\          mkdir_parent ~ctxt f (Filename.dirname tgt);\n\          if not (Sys.file_exists tgt) then\n\            begin\n\              f tgt;\n\              mkdir ~ctxt tgt\n\            end\n\        end\n\n\n\  let rmdir ~ctxt tgt =\n\    if Sys.readdir tgt = [||] then begin\n\      match Sys.os_type with\n\        | \"Win32\" ->\n\            OASISExec.run ~ctxt \"rd\" [q tgt]\n\        | _ ->\n\            OASISExec.run ~ctxt \"rm\" [\"-r\"; q tgt]\n\    end else begin\n\      OASISMessage.error ~ctxt\n\        (f_ \"Cannot remove directory '%s': not empty.\")\n\        tgt\n\    end\n\n\n\  let glob ~ctxt fn =\n\   let basename =\n\     Filename.basename fn\n\   in\n\     if String.length basename >= 2 &&\n\        basename.[0] = '*' &&\n\        basename.[1] = '.' then\n\       begin\n\         let ext_len =\n\           (String.length basename) - 2\n\         in\n\         let ext =\n\           String.sub basename 2 ext_len\n\         in\n\         let dirname =\n\           Filename.dirname fn\n\         in\n\           Array.fold_left\n\             (fun acc fn ->\n\                try\n\                  let fn_ext =\n\                    String.sub\n\                      fn\n\                      ((String.length fn) - ext_len)\n\                      ext_len\n\                  in\n\                    if fn_ext = ext then\n\                      (Filename.concat dirname fn) :: acc\n\                    else\n\                      acc\n\                with Invalid_argument _ ->\n\                  acc)\n\             []\n\             (Sys.readdir dirname)\n\       end\n\     else\n\       begin\n\         if file_exists_case fn then\n\           [fn]\n\         else\n\           []\n\       end\nend\n\n"