CristalCaveGem » LustreC

(* setup.ml generated for the first time by OASIS v0.2.0 *)

(* OASIS_START *)

(* DO NOT EDIT (digest: bfbef9a3c28e55b657d10679aeb14c68) *)

(*

   Regenerated by OASIS v0.2.0

   Visit http://oasis.forge.ocamlcore.org for more information and

   documentation about functions used in this file.

*)

module OASISGettext = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISGettext.ml"

  let ns_ str = 

    str

  let s_ str = 

    str

  let f_ (str : ('a, 'b, 'c, 'd) format4) =

    str

  let fn_ fmt1 fmt2 n =

    if n = 1 then

      fmt1^^""

    else

      fmt2^^""

  let init = 

    []

end

module OASISContext = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISContext.ml"

  open OASISGettext 

  type level =

    [ `Debug

    | `Info 

    | `Warning

    | `Error]

  type t =

    {

      verbose:        bool;

      debug:          bool;

      ignore_plugins: bool;

      printf:         level -> string -> unit; 

    }

  let printf lvl str = 

    let beg = 

      match lvl with 

        | `Error -> s_ "E: "

        | `Warning -> s_ "W: "

        | `Info  -> s_ "I: "

        | `Debug -> s_ "D: "

    in

      match lvl with 

        | `Error ->

            prerr_endline (beg^str)

        | _ ->

            print_endline (beg^str)

  let default =

    ref 

      {

        verbose        = true;

        debug          = false;

        ignore_plugins = false;

        printf         = printf;

      }

  let quiet = 

    {!default with 

         verbose = false;

         debug   = false;

    }

  let args () =

    ["-quiet",

     Arg.Unit (fun () -> default := {!default with verbose = false}),

     (s_ " Run quietly");

     "-debug",

     Arg.Unit (fun () -> default := {!default with debug = true}),

     (s_ " Output debug message")]

end

module OASISUtils = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISUtils.ml"

  module MapString = Map.Make(String)

  let map_string_of_assoc assoc =

    List.fold_left

      (fun acc (k, v) -> MapString.add k v acc)

      MapString.empty

      assoc

  module SetString = Set.Make(String)

  let set_string_add_list st lst =

    List.fold_left 

      (fun acc e -> SetString.add e acc)

      st

      lst

  let set_string_of_list =

    set_string_add_list

      SetString.empty

  let compare_csl s1 s2 = 

    String.compare (String.lowercase s1) (String.lowercase s2)

  module HashStringCsl = 

    Hashtbl.Make

      (struct

         type t = string

         let equal s1 s2 = 

             (String.lowercase s1) = (String.lowercase s2)

         let hash s =

           Hashtbl.hash (String.lowercase s)

       end)

  let split sep str =

    let str_len =

      String.length str

    in

    let rec split_aux acc pos =

      if pos < str_len then

        (

          let pos_sep = 

            try

              String.index_from str pos sep

            with Not_found ->

              str_len

          in

          let part = 

            String.sub str pos (pos_sep - pos) 

          in

          let acc = 

            part :: acc

          in

            if pos_sep >= str_len then

              (

                (* Nothing more in the string *)

                List.rev acc

              )

            else if pos_sep = (str_len - 1) then

              (

                (* String end with a separator *)

                List.rev ("" :: acc)

              )

            else

              (

                split_aux acc (pos_sep + 1)

              )

        )

      else

        (

          List.rev acc

        )

    in

      split_aux [] 0

  let varname_of_string ?(hyphen='_') s = 

    if String.length s = 0 then

      begin

        invalid_arg "varname_of_string" 

      end

    else

      begin

        let buff = 

          Buffer.create (String.length s)

        in

          (* Start with a _ if digit *)

          if '0' <= s.[0] && s.[0] <= '9' then

            Buffer.add_char buff hyphen;

          String.iter

            (fun c ->

               if ('a' <= c && c <= 'z') 

                 || 

                  ('A' <= c && c <= 'Z') 

                 || 

                  ('0' <= c && c <= '9') then

                 Buffer.add_char buff c

               else

                 Buffer.add_char buff hyphen)

            s;

          String.lowercase (Buffer.contents buff)

      end

  let varname_concat ?(hyphen='_') p s = 

    let p = 

      let p_len =

        String.length p

      in

        if p_len > 0 && p.[p_len - 1] = hyphen then

          String.sub p 0 (p_len - 1)

        else

          p

    in

    let s = 

      let s_len =

        String.length s

      in

        if s_len > 0 && s.[0] = hyphen then

          String.sub s 1 (s_len - 1)

        else

          s

    in

      Printf.sprintf "%s%c%s" p hyphen s

  let is_varname str = 

    str = varname_of_string str

  let failwithf1 fmt a =

    failwith (Printf.sprintf fmt a)

  let failwithf2 fmt a b =

    failwith (Printf.sprintf fmt a b)

  let failwithf3 fmt a b c =

    failwith (Printf.sprintf fmt a b c)

  let failwithf4 fmt a b c d =

    failwith (Printf.sprintf fmt a b c d)

  let failwithf5 fmt a b c d e =

    failwith (Printf.sprintf fmt a b c d e)

end

module PropList = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/PropList.ml"

  open OASISGettext

  type name = string

  exception Not_set of name * string option 

  exception No_printer of name

  exception Unknown_field of name * name

  let string_of_exception =

    function

      | Not_set (nm, Some rsn) ->

          Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn

      | Not_set (nm, None) ->

          Printf.sprintf (f_ "Field '%s' is not set") nm

      | No_printer nm ->

          Printf.sprintf (f_ "No default printer for value %s") nm

      | Unknown_field (nm, schm) ->

          Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm

      | e ->

          raise e

  module Data =

  struct

    type t = 

        (name, unit -> unit) Hashtbl.t

    let create () =

      Hashtbl.create 13

    let clear t =

      Hashtbl.clear t

# 59 "/build/buildd/oasis-0.2.0/src/oasis/PropList.ml"

  end

  module Schema = 

  struct

    type ('ctxt, 'extra) value =

        {

          get:   Data.t -> string;

          set:   Data.t -> ?context:'ctxt -> string -> unit;

          help:  (unit -> string) option;

          extra: 'extra;

        }

    type ('ctxt, 'extra) t =

        {

          name:      name;

          fields:    (name, ('ctxt, 'extra) value) Hashtbl.t;

          order:     name Queue.t;

          name_norm: string -> string;

        }

    let create ?(case_insensitive=false) nm = 

      {

        name      = nm;

        fields    = Hashtbl.create 13;

        order     = Queue.create ();

        name_norm = 

          (if case_insensitive then 

             String.lowercase

           else

             fun s -> s);

      }

    let add t nm set get extra help = 

      let key = 

        t.name_norm nm

      in

        if Hashtbl.mem t.fields key then

          failwith

            (Printf.sprintf 

               (f_ "Field '%s' is already defined in schema '%s'")

               nm t.name);

        Hashtbl.add 

          t.fields 

          key 

          {

            set   = set; 

            get   = get; 

            help  = help;

            extra = extra;

          };

        Queue.add nm t.order 

    let mem t nm =

      Hashtbl.mem t.fields nm 

    let find t nm = 

      try

        Hashtbl.find t.fields (t.name_norm nm)

      with Not_found ->

        raise (Unknown_field (nm, t.name))

    let get t data nm =

      (find t nm).get data

    let set t data nm ?context x =

      (find t nm).set 

        data 

        ?context 

        x

    let fold f acc t =

      Queue.fold 

        (fun acc k ->

           let v =

             find t k

           in

             f acc k v.extra v.help)

        acc 

        t.order

    let iter f t =

      fold 

        (fun () -> f)

        ()

        t

    let name t = 

      t.name

  end

  module Field =

  struct

    type ('ctxt, 'value, 'extra) t =

        {

          set:    Data.t -> ?context:'ctxt -> 'value -> unit;

          get:    Data.t -> 'value;

          sets:   Data.t -> ?context:'ctxt -> string -> unit;

          gets:   Data.t -> string;

          help:   (unit -> string) option;

          extra:  'extra;

        }

    let new_id = 

      let last_id =

        ref 0

      in

        fun () -> incr last_id; !last_id

    let create ?schema ?name ?parse ?print ?default ?update ?help extra =

      (* Default value container *)

      let v = 

        ref None 

      in

      (* If name is not given, create unique one *)

      let nm = 

        match name with 

          | Some s -> s

          | None -> Printf.sprintf "_anon_%d" (new_id ())

      in

      (* Last chance to get a value: the default *)

      let default () = 

        match default with 

          | Some d -> d

          | None -> raise (Not_set (nm, Some (s_ "no default value")))

      in

      (* Get data *)

      let get data =

        (* Get value *)

        try 

          (Hashtbl.find data nm) ();

          match !v with 

            | Some x -> x 

            | None -> default ()

        with Not_found ->

          default ()

      in

      (* Set data *)

      let set data ?context x = 

        let x = 

          match update with 

            | Some f ->

                begin

                  try 

                    f ?context (get data) x

                  with Not_set _ ->

                    x

                end

            | None ->

                x

        in

          Hashtbl.replace 

            data 

            nm 

            (fun () -> v := Some x) 

      in

      (* Parse string value, if possible *)

      let parse =

        match parse with 

          | Some f -> 

              f

          | None ->

              fun ?context s ->

                failwith 

                  (Printf.sprintf 

                     (f_ "Cannot parse field '%s' when setting value %S")

                     nm

                     s)

      in

      (* Set data, from string *)

      let sets data ?context s =

        set ?context data (parse ?context s)

      in

      (* Output value as string, if possible *)

      let print =

        match print with

          | Some f ->

              f

          | None ->

              fun _ -> raise (No_printer nm)

      in

      (* Get data, as a string *)

      let gets data =

        print (get data)

      in

        begin 

          match schema with 

            | Some t ->

                Schema.add t nm sets gets extra help

            | None ->

                ()

        end;

        {

          set   = set;

          get   = get;

          sets  = sets;

          gets  = gets;

          help  = help;

          extra = extra;

        }

    let fset data t ?context x = 

      t.set data ?context x

    let fget data t =

      t.get data

    let fsets data t ?context s =

      t.sets data ?context s

    let fgets data t =

      t.gets data 

  end

  module FieldRO =

  struct

    let create ?schema ?name ?parse ?print ?default ?update ?help extra =

      let fld = 

        Field.create ?schema ?name ?parse ?print ?default ?update ?help extra

      in

        fun data -> Field.fget data fld

  end

end

module OASISMessage = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISMessage.ml"

  open OASISGettext

  open OASISContext

  let generic_message ~ctxt lvl fmt =

    let cond = 

      match lvl with 

        | `Debug -> ctxt.debug

        | _ -> ctxt.verbose

    in

      Printf.ksprintf 

        (fun str -> 

           if cond then

             begin

               ctxt.printf lvl str

             end)

        fmt

  let debug ~ctxt fmt =

    generic_message ~ctxt `Debug fmt

  let info ~ctxt fmt = 

    generic_message ~ctxt `Info fmt

  let warning ~ctxt fmt =

    generic_message ~ctxt `Warning fmt

  let error ~ctxt fmt =

    generic_message ~ctxt `Error fmt

  let string_of_exception e = 

    try 

      PropList.string_of_exception e

    with 

      | Failure s ->

          s

      | e ->

          Printexc.to_string e

  (* TODO

  let register_exn_printer f =

   *)

end

module OASISVersion = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISVersion.ml"

  open OASISGettext

  type s = string

  type t = string 

  type comparator = 

    | VGreater of t

    | VGreaterEqual of t

    | VEqual of t

    | VLesser of t

    | VLesserEqual of t

    | VOr of  comparator * comparator

    | VAnd of comparator * comparator

  (* Range of allowed characters *)

  let is_digit c =

    '0' <= c && c <= '9'

  let is_alpha c =

    ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')

  let is_special =

    function 

      | '.' | '+' | '-' | '~' -> true

      | _ -> false

  let rec version_compare v1 v2 =

    if v1 <> "" || v2 <> "" then

      begin

        (* Compare ascii string, using special meaning for version 

         * related char

         *)

        let val_ascii c = 

          if c = '~' then -1

          else if is_digit c then 0

          else if c = '\000' then 0

          else if is_alpha c then Char.code c

          else (Char.code c) + 256

        in

        let len1 = String.length v1 in

        let len2 = String.length v2 in

        let p = ref 0 in

        (** Compare ascii part *)

        let compare_vascii () = 

          let cmp = ref 0 in

          while !cmp = 0 && 

                !p < len1 && !p < len2 && 

                not (is_digit v1.[!p] && is_digit v2.[!p]) do 

            cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);

            incr p

          done;

          if !cmp = 0 && !p < len1 && !p = len2 then

            val_ascii v1.[!p] 

          else if !cmp = 0 && !p = len1 && !p < len2 then

            - (val_ascii v2.[!p])

          else

            !cmp

        in

        (** Compare digit part *)

        let compare_digit () = 

          let extract_int v p =

            let start_p = !p in

              while !p < String.length v && is_digit v.[!p] do 

                incr p

              done;

              match String.sub v start_p (!p - start_p) with 

                | "" -> 0, 

                        v

                | s -> int_of_string s, 

                       String.sub v !p ((String.length v) - !p)

          in

          let i1, tl1 = extract_int v1 (ref !p) in

          let i2, tl2 = extract_int v2 (ref !p) in

            i1 - i2, tl1, tl2

        in

          match compare_vascii () with

            | 0 ->

                begin

                  match compare_digit () with 

                    | 0, tl1, tl2 ->

                        if tl1 <> "" && is_digit tl1.[0] then

                          1

                        else if tl2 <> "" && is_digit tl2.[0] then

                          -1

                        else

                          version_compare tl1 tl2

                    | n, _, _ ->

                        n

                end

            | n ->

                n

      end

    else

      begin

        0

      end

  let version_of_string str =

    String.iter 

      (fun c ->

         if is_alpha c || is_digit c || is_special c then

           ()

         else

           failwith

             (Printf.sprintf 

                (f_ "Char %C is not allowed in version '%s'")

                c str))

      str;

    str

  let string_of_version t =

    t

  let chop t = 

    try 

      let pos = 

        String.rindex t '.' 

      in

        String.sub t 0 pos

    with Not_found ->

      t

  let rec comparator_apply v op =

    match op with

      | VGreater cv ->

          (version_compare v cv) > 0

      | VGreaterEqual cv ->

          (version_compare v cv) >= 0

      | VLesser cv ->

          (version_compare v cv) < 0

      | VLesserEqual cv ->

          (version_compare v cv) <= 0

      | VEqual cv ->

          (version_compare v cv) = 0

      | VOr (op1, op2) ->

          (comparator_apply v op1) || (comparator_apply v op2)

      | VAnd (op1, op2) ->

          (comparator_apply v op1) && (comparator_apply v op2)

  let rec string_of_comparator =

    function 

      | VGreater v  -> "> "^(string_of_version v)

      | VEqual v    -> "= "^(string_of_version v)

      | VLesser v   -> "< "^(string_of_version v)

      | VGreaterEqual v -> ">= "^(string_of_version v)

      | VLesserEqual v  -> "<= "^(string_of_version v)

      | VOr (c1, c2)  -> 

          (string_of_comparator c1)^" || "^(string_of_comparator c2)

      | VAnd (c1, c2) -> 

          (string_of_comparator c1)^" && "^(string_of_comparator c2)

  let rec varname_of_comparator =

    let concat p v = 

      OASISUtils.varname_concat

        p 

        (OASISUtils.varname_of_string 

           (string_of_version v))

    in

      function 

        | VGreater v -> concat "gt" v

        | VLesser v  -> concat "lt" v

        | VEqual v   -> concat "eq" v

        | VGreaterEqual v -> concat "ge" v

        | VLesserEqual v  -> concat "le" v

        | VOr (c1, c2) ->

            (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)

        | VAnd (c1, c2) ->

            (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)

end

module OASISLicense = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISLicense.ml"

  (** License for _oasis fields

      @author Sylvain Le Gall

    *)

  type license = string 

  type license_exception = string 

  type license_version = 

    | Version of OASISVersion.t

    | VersionOrLater of OASISVersion.t

    | NoVersion

  type license_dep_5 = 

      {

        license:    license;

        exceptions: license_exception list;

        version:    license_version;

      } 

  type t =

    | DEP5License of license_dep_5

    | OtherLicense of string (* URL *)

end

module OASISExpr = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISExpr.ml"

  open OASISGettext

  type test = string 

  type flag = string 

  type t =

    | EBool of bool

    | ENot of t

    | EAnd of t * t

    | EOr of t * t

    | EFlag of flag

    | ETest of test * string

  type 'a choices = (t * 'a) list 

  let eval var_get t =

    let rec eval' = 

      function

        | EBool b ->

            b

        | ENot e -> 

            not (eval' e)

        | EAnd (e1, e2) ->

            (eval' e1) && (eval' e2)

        | EOr (e1, e2) -> 

            (eval' e1) || (eval' e2)

        | EFlag nm ->

            let v =

              var_get nm

            in

              assert(v = "true" || v = "false");

              (v = "true")

        | ETest (nm, vl) ->

            let v =

              var_get nm

            in

              (v = vl)

    in

      eval' t

  let choose ?printer ?name var_get lst =

    let rec choose_aux = 

      function

        | (cond, vl) :: tl ->

            if eval var_get cond then 

              vl 

            else

              choose_aux tl

        | [] ->

            let str_lst = 

              if lst = [] then

                s_ "<empty>"

              else

                String.concat 

                  (s_ ", ")

                  (List.map

                     (fun (cond, vl) ->

                        match printer with

                          | Some p -> p vl

                          | None -> s_ "<no printer>")

                     lst)

            in

              match name with 

                | Some nm ->

                    failwith

                      (Printf.sprintf 

                         (f_ "No result for the choice list '%s': %s")

                         nm str_lst)

                | None ->

                    failwith

                      (Printf.sprintf

                         (f_ "No result for a choice list: %s")

                         str_lst)

    in

      choose_aux (List.rev lst)

end

module OASISTypes = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISTypes.ml"

  type name          = string 

  type package_name  = string 

  type url           = string 

  type unix_dirname  = string 

  type unix_filename = string 

  type host_dirname  = string 

  type host_filename = string 

  type prog          = string 

  type arg           = string 

  type args          = string list 

  type command_line  = (prog * arg list) 

  type findlib_name = string 

  type findlib_full = string 

  type compiled_object =

    | Byte

    | Native

    | Best

  type dependency = 

    | FindlibPackage of findlib_full * OASISVersion.comparator option

    | InternalLibrary of name

  type tool =

    | ExternalTool of name

    | InternalExecutable of name 

  type vcs = 

    | Darcs 

    | Git 

    | Svn 

    | Cvs 

    | Hg 

    | Bzr 

    | Arch 

    | Monotone

    | OtherVCS of url

  type plugin_kind = 

      [  `Configure 

       | `Build 

       | `Doc 

       | `Test 

       | `Install 

       | `Extra

      ]

  type plugin_data_purpose =

      [  `Configure

       | `Build

       | `Install

       | `Clean

       | `Distclean

       | `Install

       | `Uninstall

       | `Test

       | `Doc

       | `Extra

       | `Other of string

      ]

  type 'a plugin = 'a * name * OASISVersion.t option 

  type all_plugin = plugin_kind plugin 

  type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list

# 102 "/build/buildd/oasis-0.2.0/src/oasis/OASISTypes.ml"

  type 'a conditional = 'a OASISExpr.choices 

  type custom = 

      {

        pre_command:  (command_line option) conditional;

        post_command: (command_line option) conditional; 

      }

  type common_section =

      {

        cs_name: name;

        cs_data: PropList.Data.t;

        cs_plugin_data: plugin_data;

      }

  type build_section =

      {

        bs_build:           bool conditional;

        bs_install:         bool conditional;

        bs_path:            unix_dirname;

        bs_compiled_object: compiled_object;

        bs_build_depends:   dependency list;

        bs_build_tools:     tool list;

        bs_c_sources:       unix_filename list;

        bs_data_files:      (unix_filename * unix_filename option) list;

        bs_ccopt:           args conditional;

        bs_cclib:           args conditional;

        bs_dlllib:          args conditional;

        bs_dllpath:         args conditional;

        bs_byteopt:         args conditional;

        bs_nativeopt:       args conditional;

      }

  type library = 

      {

        lib_modules:            string list;

        lib_internal_modules:   string list;

        lib_findlib_parent:     findlib_name option;

        lib_findlib_name:       findlib_name option;

        lib_findlib_containers: findlib_name list;

      } 

  type executable = 

      {

        exec_custom:          bool;

        exec_main_is:         unix_filename;

      } 

  type flag = 

      {

        flag_description:  string option;

        flag_default:      bool conditional;

      } 

  type source_repository = 

      {

        src_repo_type:        vcs;

        src_repo_location:    url;

        src_repo_browser:     url option;

        src_repo_module:      string option;

        src_repo_branch:      string option;

        src_repo_tag:         string option;

        src_repo_subdir:      unix_filename option;

      } 

  type test = 

      {

        test_type:               [`Test] plugin;

        test_command:            command_line conditional;

        test_custom:             custom;

        test_working_directory:  unix_filename option;

        test_run:                bool conditional;

        test_tools:              tool list;

      } 

  type doc_format =

    | HTML of unix_filename

    | DocText

    | PDF

    | PostScript

    | Info of unix_filename

    | DVI

    | OtherDoc

  type doc =

      {

        doc_type:        [`Doc] plugin;

        doc_custom:      custom;

        doc_build:       bool conditional;

        doc_install:     bool conditional;

        doc_install_dir: unix_filename;

        doc_title:       string;

        doc_authors:     string list;

        doc_abstract:    string option;

        doc_format:      doc_format;

        doc_data_files:  (unix_filename * unix_filename option) list;

        doc_build_tools: tool list;

      } 

  type section =

    | Library    of common_section * build_section * library

    | Executable of common_section * build_section * executable

    | Flag       of common_section * flag

    | SrcRepo    of common_section * source_repository

    | Test       of common_section * test

    | Doc        of common_section * doc

  type package = 

      {

        oasis_version:    OASISVersion.t;

        ocaml_version:    OASISVersion.comparator option;

        findlib_version:  OASISVersion.comparator option;

        name:             package_name;

        version:          OASISVersion.t;

        license:          OASISLicense.t;

        license_file:     unix_filename option;

        copyrights:       string list;

        maintainers:      string list;

        authors:          string list;

        homepage:         url option;

        synopsis:         string;

        description:      string option;

        categories:       url list;

        conf_type:        [`Configure] plugin;

        conf_custom:      custom;

        build_type:       [`Build] plugin;

        build_custom:     custom;

        install_type:     [`Install] plugin;

        install_custom:   custom;

        uninstall_custom: custom;

        clean_custom:     custom;

        distclean_custom: custom;

        files_ab:         unix_filename list;

        sections:         section list;

        plugins:          [`Extra] plugin list;

        schema_data:      PropList.Data.t;

        plugin_data:      plugin_data;

      } 

end

module OASISUnixPath = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISUnixPath.ml"

  type unix_filename = string

  type unix_dirname = string

  type host_filename = string

  type host_dirname = string

  let current_dir_name = "."

  let parent_dir_name = ".."

  let concat f1 f2 = 

    if f1 = current_dir_name then

      f2

    else if f2 = current_dir_name then

      f1

    else

      f1^"/"^f2

  let make =

    function

      | hd :: tl ->

          List.fold_left

            (fun f p -> concat f p)

            hd

            tl

      | [] ->

          invalid_arg "OASISUnixPath.make"

  let dirname f =

    try

      String.sub f 0 (String.rindex f '/')

    with Not_found ->

      current_dir_name

  let basename f =

    try 

      let pos_start =

        (String.rindex f '/') + 1

      in

        String.sub f pos_start ((String.length f) - pos_start)

    with Not_found ->

      f

  let chop_extension f =

    try 

      let last_dot =

        String.rindex f '.'

      in

      let sub =

        String.sub f 0 last_dot

      in

        try 

          let last_slash =

            String.rindex f '/'

          in

            if last_slash < last_dot then

              sub

            else

              f

        with Not_found ->

          sub

    with Not_found ->

      f

end

module OASISSection = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISSection.ml"

  (** Manipulate section 

      @author Sylvain Le Gall

    *)

  open OASISTypes

  type section_kind =

    | KLibrary 

    | KExecutable

    | KFlag

    | KSrcRepo

    | KTest

    | KDoc

  (** Extract generic information 

    *)

  let section_kind_common = 

    function

      | Library (cs, _, _) -> 

          KLibrary, cs

      | Executable (cs, _, _) ->

          KExecutable, cs

      | Flag (cs, _) ->

          KFlag, cs

      | SrcRepo (cs, _) ->

          KSrcRepo, cs

      | Test (cs, _) ->

          KTest, cs

      | Doc (cs, _) ->

          KDoc, cs

  (** Common section of a section

    *)

  let section_common sct =

    snd (section_kind_common sct)

  (** Key used to identify section

    *)

  let section_id sct = 

    let k, cs = 

      section_kind_common sct

    in

      k, cs.cs_name

  let string_of_section sct =

    let k, nm =

      section_id sct

    in

      (match k with

         | KLibrary    -> "library" 

         | KExecutable -> "executable"

         | KFlag       -> "flag"

         | KSrcRepo    -> "src repository"

         | KTest       -> "test"

         | KDoc        -> "doc")

      ^" "^nm

end

module OASISBuildSection = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISBuildSection.ml"

end

module OASISExecutable = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISExecutable.ml"

  open OASISTypes

  let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = 

    let dir = 

      OASISUnixPath.concat

        bs.bs_path

        (OASISUnixPath.dirname exec.exec_main_is)

    in

    let is_native_exec = 

      match bs.bs_compiled_object with

        | Native -> true

        | Best -> is_native ()

        | Byte -> false

    in

      OASISUnixPath.concat

        dir

        (cs.cs_name^(suffix_program ())),

      if not is_native_exec && 

         not exec.exec_custom && 

         bs.bs_c_sources <> [] then

        Some (dir^"/dll"^cs.cs_name^(ext_dll ()))

      else

        None

end

module OASISLibrary = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISLibrary.ml"

  open OASISTypes

  open OASISUtils

  open OASISGettext

  type library_name = name

  let generated_unix_files ~ctxt (cs, bs, lib) 

        source_file_exists is_native ext_lib ext_dll =  

    (* The headers that should be compiled along *)

    let headers = 

      List.fold_left

        (fun hdrs modul ->

           try 

             let base_fn = 

               List.find

                 (fun fn -> 

                    source_file_exists (fn^".ml") ||

                    source_file_exists (fn^".mli") ||

                    source_file_exists (fn^".mll") ||

                    source_file_exists (fn^".mly")) 

                 (List.map

                    (OASISUnixPath.concat bs.bs_path)

                    [modul;

                     String.uncapitalize modul;

                     String.capitalize modul])

             in

               [base_fn^".cmi"] :: hdrs

           with Not_found ->

             OASISMessage.warning

               ~ctxt

               (f_ "Cannot find source file matching \

                    module '%s' in library %s")

               modul cs.cs_name;

               (List.map (OASISUnixPath.concat bs.bs_path)

                  [modul^".cmi";

                   String.uncapitalize modul ^ ".cmi";

                   String.capitalize modul ^ ".cmi"])

               :: hdrs)

        []

        lib.lib_modules

    in

    let acc_nopath =

      []

    in

    (* Compute what libraries should be built *)

    let acc_nopath =

      let byte acc =

        [cs.cs_name^".cma"] :: acc

      in

      let native acc =

        [cs.cs_name^".cmxa"] :: [cs.cs_name^(ext_lib ())] :: acc

      in

        match bs.bs_compiled_object with 

          | Native ->

              byte (native acc_nopath)

          | Best when is_native () ->

              byte (native acc_nopath)

          | Byte | Best ->

              byte acc_nopath

    in

    (* Add C library to be built *)

    let acc_nopath = 

      if bs.bs_c_sources <> [] then

        begin

          ["lib"^cs.cs_name^(ext_lib ())]

          ::

          ["dll"^cs.cs_name^(ext_dll ())]

          ::

          acc_nopath

        end

      else

        acc_nopath

    in

      (* All the files generated *)

      List.rev_append

        (List.rev_map

           (List.rev_map

              (OASISUnixPath.concat bs.bs_path))

           acc_nopath)

        headers

  type group_t = 

    | Container of findlib_name * (group_t list)

    | Package of (findlib_name * 

                  common_section *

                  build_section * 

                  library * 

                  (group_t list))

  let group_libs pkg =

    (** Associate a name with its children *)

    let children =

      List.fold_left

        (fun mp ->

           function

             | Library (cs, bs, lib) ->

                 begin

                   match lib.lib_findlib_parent with 

                     | Some p_nm ->

                         begin

                           let children =

                             try 

                               MapString.find p_nm mp

                             with Not_found ->

                               []

                           in

                             MapString.add p_nm ((cs, bs, lib) :: children) mp

                         end

                     | None ->

                         mp

                 end

             | _ ->

                 mp)

        MapString.empty

        pkg.sections

    in

    (* Compute findlib name of a single node *)

    let findlib_name (cs, _, lib) =

      match lib.lib_findlib_name with 

        | Some nm -> nm

        | None -> cs.cs_name

    in

    (** Build a package tree *)

    let rec tree_of_library containers ((cs, bs, lib) as acc) =

      match containers with

        | hd :: tl ->

            Container (hd, [tree_of_library tl acc])

        | [] ->

            (* TODO: allow merging containers with the same 

             * name 

             *)

            Package 

              (findlib_name acc, cs, bs, lib,

               (try 

                  List.rev_map 

                    (fun ((_, _, child_lib) as child_acc) ->

                       tree_of_library 

                         child_lib.lib_findlib_containers

                         child_acc)

                    (MapString.find cs.cs_name children)

                with Not_found ->

                  []))

    in

      (* TODO: check that libraries are unique *)

      List.fold_left

        (fun acc ->

           function

             | Library (cs, bs, lib) when lib.lib_findlib_parent = None -> 

                 (tree_of_library lib.lib_findlib_containers (cs, bs, lib)) :: acc

             | _ ->

                 acc)

        []

        pkg.sections

  (** Compute internal to findlib library matchings, including subpackage

      and return a map of it.

    *)

  let findlib_name_map pkg = 

    (* Compute names in a tree *)

    let rec findlib_names_aux path mp grp =

      let fndlb_nm, children, mp =

        match grp with

          | Container (fndlb_nm, children) ->

              fndlb_nm, children, mp

          | Package (fndlb_nm, {cs_name = nm}, _, _, children) ->

              fndlb_nm, children, (MapString.add nm (path, fndlb_nm) mp)

      in

      let fndlb_nm_full =

        (match path with

           | Some pth -> pth^"."

           | None -> "")^

        fndlb_nm

      in

        List.fold_left

          (findlib_names_aux (Some fndlb_nm_full))

          mp

          children

    in

      List.fold_left

        (findlib_names_aux None)

        MapString.empty

        (group_libs pkg)

  let findlib_of_name ?(recurse=false) map nm =

    try 

      let (path, fndlb_nm) = 

        MapString.find nm map

      in

        match path with 

          | Some pth when recurse -> pth^"."^fndlb_nm

          | _ -> fndlb_nm

    with Not_found ->

      failwithf1

        (f_ "Unable to translate internal library '%s' to findlib name")

        nm

  let name_findlib_map pkg =

    let mp = 

      findlib_name_map pkg

    in

      MapString.fold

        (fun nm _ acc -> 

           let fndlb_nm_full =

             findlib_of_name 

               ~recurse:true 

               mp 

               nm

           in

             MapString.add fndlb_nm_full nm acc)

        mp

        MapString.empty

  let findlib_of_group = 

    function

      | Container (fndlb_nm, _) 

      | Package (fndlb_nm, _, _, _, _) -> fndlb_nm

  let root_of_group grp =

    let rec root_lib_aux =

      function 

        | Container (_, children) ->

            root_lib_lst children        

        | Package (_, cs, bs, lib, children) ->

            if lib.lib_findlib_parent = None then 

              cs, bs, lib

            else

              root_lib_lst children

    and root_lib_lst =

      function

        | [] ->

            raise Not_found

        | hd :: tl ->

            try

              root_lib_aux hd

            with Not_found ->

              root_lib_lst tl

    in

      try

        root_lib_aux grp

      with Not_found ->

        failwithf1

          (f_ "Unable to determine root library of findlib library '%s'")

          (findlib_of_group grp)

end

module OASISFlag = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISFlag.ml"

end

module OASISPackage = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISPackage.ml"

end

module OASISSourceRepository = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISSourceRepository.ml"

end

module OASISTest = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISTest.ml"

end

module OASISDocument = struct

# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISDocument.ml"

end

module BaseEnvLight = struct

# 21 "/build/buildd/oasis-0.2.0/src/base/BaseEnvLight.ml"

  module MapString = Map.Make(String)

  type t = string MapString.t

  let default_filename =

    Filename.concat 

      (Sys.getcwd ())