pax_global_header00006660000000000000000000000064132700530260014510gustar00rootroot0000000000000052 comment=6d2eb3ce5a7e7622920a14c75b9db08c8b3da8bd obuild-obuild-v0.1.10/000077500000000000000000000000001327005302600145075ustar00rootroot00000000000000obuild-obuild-v0.1.10/.gitignore000066400000000000000000000000401327005302600164710ustar00rootroot00000000000000*.cmx *.o *.cmi dist src/obuild obuild-obuild-v0.1.10/.merlin000066400000000000000000000000601327005302600157720ustar00rootroot00000000000000PKG unix S ext S src S obuild S tools B dist/** obuild-obuild-v0.1.10/DESIGN.md000066400000000000000000000117331327005302600160070ustar00rootroot00000000000000OBuild Design ============= Genesis ------- Obuild started on a bank holiday after xmas, as an experiment to make the simplest OCaml build system. The mains goals are to: * provide a good user experience. * provide a building black box, no mocking around generic rules. * provide features in the highest level possible. * the cleanest build possible, with by-products hidden from the user. * provide good defaults, and standardize names as much as possible. * expose everything that the user of the build system needs in one place. * be simple to build to prevent any bootstrapping problem. One of the main influences was Haskell Cabal, which provides to all Haskellers a simple way to provide a build system to a project with a single file. This applies well for the myriad of OCaml options too. Simple to build --------------- Obuild is buildable with just the compiler and the compiler standard library. This make bootstrapping very easy: all you need is the OCaml compiler installed. This creates some pain for developers of obuild, as lots of basic functions available in others libraries need to written again as part of obuild. As the initial development was done really quickly, some functions are not as performant (CPU or memory-wise) as they could be. This can be fixed as problem becomes apparent in scaling. Simple to use ------------- Each project is described really simply in a one place, in a user friendly format. a central .obuild file is used, and provide high level description of your project. Along with some meta data (name, authors, description, etc), it defines the library, and\/or executable that the project want to have, from which inputs (source files, modules). All dependencies is fully autogenerated internally and used to recompile only the necessary bits. Along with library and executable, test and benchmark can be defined, so as to provide a easy way to test or bench some part of your project. It also provides a standard on how to build and execute tests and benchmarks. Later on, because of this integration it could provide way to make nice reports (html/javascript) based on output of benchs and tests. Standardizing documentation --------------------------- Providing a standard to generate and install documentation, is one of the sub goals of obuild. This will go a long way to provide documentation in a centralized place for all libraries in the ocaml world. Internal META parsing --------------------- ocamlfind is the current de-facto standard for the installed package querying. ocamlfind is usually injected on the command line to ocamlopt,ocamldep,ocamlc which special flags (-syntax, -package), that ocamlfind will re-write to call the program with something that the program can understand. All the informations for this transformation is stored in META files. Unfortunately this design prevent META caching, and each time ocamlc/ocamlopt is used it will reparse the META files. This also causes problem if ocamlfind does not exists when used as a program, or if the library is not installed when used as a library. Because of those 2 reasons, obuild got a tiny (0.4 KLoC) rewrite of the necessary part of findlib (3 KLoC). It is not as generic as the original library. Internal Design --------------- By being a single program that knows about how things are supposed to be built, obuild is in the unique position of caching more and going faster. At the moment, there is lots of parsing redundancy for example: * a file using campl4, result in camlp4 being called at minimum 2 times as a preprocessor: one for running ocamldep, and one for running ocamlc. Each time camlp4 is called, it result in the camlp4 grammar files being reloaded, and camlp4 will output the same things again. It get worse if you are also compiling other version. (e.g. a native version, a bytecode version with debug, a native version with debug, a native version with profiling). This lead to camlp4 called up to 7 times, to produce the exact same thing. * without a .mli file, bytecode and native version will also cause ocamlc and ocamlopt to parse an .ml file twice. This could be made better. If the ocaml compiler add support for providing an already parsed .ml file to ocamlc or ocamlopt, obuild could take advantage of this really easily. Also provided compilation re-entrancy and ability to use the ocaml compiler as a library, obuild could use the compiler as a library. Librification ------------- Obuild has been designed to be used as a library eventually. The code is shifting towards using pure structure and functions, so that things can be reused. there is some global state, that will be eventually reduced to provide better control of each parts. One of the possible development of this, would be to provide an optional daemon that monitor file changes, and automatically rebuild on demand without having to re-analyze the whole project. Some other possible scenario is to have other programs use the project file format, either to provide tools to write them or tools that read them. obuild-obuild-v0.1.10/LICENSE000066400000000000000000000024521327005302600155170ustar00rootroot00000000000000Copyright (c) 2013 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. obuild-obuild-v0.1.10/OBUILD_SPEC.md000066400000000000000000000034541327005302600166270ustar00rootroot00000000000000# obuild file specification (DRAFT) Here are the fields accepted in obuild files The syntax is field (flags): accepted_values * field = string * flags = M (mandatory) * boolean = true | True | false | False * accepted_values = comma separated string list | string list | string | boolean # Section types * executable * library * flag * test * bench * example # Toplevel fields These fields are only accepted in the top level, i.e. not in target sections, etc. * name (M): string * version (M): string * obuild-ver (M): 1 * synopsis: * description: * licence | license: string: Licence for the project * licence-file | license-file: string: Filename of the licence in the project directory * homepage: string: URL of the homepage of the project * tools: ? * authors: string list CSV, Info about the authors, separated by commas * author: string list: Info about the author * extra-srcs: ? * configure-script: ? # Target fields ## Common fields * buildable: boolean * installable: boolean ## OCaml target fields * builddepends | builddeps | build-deps: string list: ocamlfind library names * path | srcdir | src-dir: string: sources directory * preprocessor | pp: string: preprocessor to use * extra-deps: comma-separated string list: ? * stdlib: (none | no | standard | core): standard library to link ? ## C target fields * cdir | c-dir: * csources | c-sources: * cflags | c-flags | ccopts | ccopt | c-opts: * c-libpaths: * c-libs: * c-pkgs: ## Library only fields * sub | subdir | library: NO VALUE (define a new block) * per: NO VALUE (define a new block) * modules: * pack: * syntax: * description: ## Executable | Example | Test common fields * per: NO VALUE (define a new block) * main | mainis | main-is: string: ml file being the entry point for the executable ## Test only fields * rundir: * runopt: obuild-obuild-v0.1.10/README.md000066400000000000000000000100521327005302600157640ustar00rootroot00000000000000obuild ====== A parallel, incremental and declarative build system for OCaml. Design ------ The goal is to make a very simple build system for users and developers of OCaml library and programs. `obuild` acts as building black box: user declare only what they want to build and with which sources, and it will be consistently built. The design is based on Haskell's Cabal, and borrow most of the layout and way of working, adapting parts where necessary to support OCaml fully. There's no way to build things that `obuild` has not been designed to do on purpose, so that the experience provided is consistent, and all future improvements to `obuild` will automatically benefit program and libraries using older versions. Currently unsupported features should be requested on the Github issue tracker. Feature ------- * Incremental & parallel build system. only rebuilding what's necessary. * Descriptive configuration file. * Easy for users: no rules to mess about, just describe what you want. * No building dependency apart from OCaml's stdlib: easy to build * No tool or binary dependencies apart from ocaml compilers * OCamlfind-like support integrated for faster compilation How to build a project using obuild ----------------------------------- obuild supports a few sub commands: ``` obuild clean obuild configure obuild init obuild build obuild install obuild doc obuild test obuild sdist ``` * `clean`: make sure there's no build by product in the current project * `configure`: prepare the project by checking dependencies and making sure the environment is consistant. If any of the dependencies changes, the user will have to re-run the configure step. This also allow the user to change flags that impact the project. * `build`: build every buildable targets defined by the project. This will usually build a library or executables. * `sdist`: create a compressed archive package with the pieces needed to distribute it via source code. * `doc`: build the documentation associated with the sources * `test`: run unit tests * `install`: install the necessary files of a library or executable How to write a project file --------------------------- A project file is a file terminated by the `.obuild` extension. Only one per project is supported. The content is declarative using a simple layout format. Every normal line needs to be in a "key: value" format. Multiple lines are supported by indenting (with spaces) the value related to the key. ``` name: myproject version: 0.0.1 description: This is my new cool project . This is a long description describing properly what the project does. licence: MyLicense authors: John Doe obuild-ver: 1 homepage: http://my.server.com/myproject ``` The different target types: * executable: this creates an executable that is going to be installed by default. * library: create a library that is going to be installed. * test: create an executable that will not be installed, and will interact with obuild according to the test_type field. cabal test will run every built tests in a row. for the exit test_type, the exit code is used to signal error (0 = success, anything else = failure) * bench: create an executable that will not be installed, and will allow to benchmarks, some part of the project. This is largely unimplemented and just a placeholder for future development. * example: create an executable that is not installed, nor compiled by default. you need to use configure with --enable-examples. This allow to make sure that examples are compiled with the sources to prevent bitrotting. At a later stage that can be used to generate extra documentation. Declaring an executable ----------------------- ``` executable myexec main-is: mymain.ml src-dir: src build-deps: unix ``` Declaring a library ------------------- ``` library mylib modules: Module1, Module2 src-dir: lib build-deps: mydep1, mydep2 ``` obuild-obuild-v0.1.10/TODO.md000066400000000000000000000043201327005302600155750ustar00rootroot00000000000000This is an unexhaustive and probably inaccurate list of items that need to be looked at or completed to make obuild even better. It is a good source of idea for anyone wanting to contribute. Projects file ------------- * support if/then/else construct in project file. * add platform and architecture tests in project file: i.e. "if arch(x86) && ..." * utf8 in project file (maybe useful ?) Better configuring ------------------ * configure storing / build checking of system state (e.g. digest of libraries, pkg-config, etc) * cache meta in a friendlier format in dist/ after configure. speed up build. * arbitrary mechanism to poke at the platform and see what it supports. feeding the file autogeneration phase. * per project and per system configuration file (à la git) Perf Improvement ---------------- * use the transitive-edge-reduced dag for checking dependencies. * remove redundant mtime checks by using a invaliding mtime hashtbl caching mechanism. * improve change detection with a digest after mtime change. * improve compilation with .mli by moving the dag pointer of its parents to the compiled interface, not the compiled module. * ocamldep parallelization & multiples Completeness ----------- * add install, and generate META * generate HTML documentation * generate cmxs * generate opam files (.install and .config) * benchs Documenting ----------- * specification for the .obuild file format * mli files and code documentation Misc ---- * init: make it better * add globs for extras source * add automatic build-deps scanning/adding (see if possible and default to off probably) * librarify some part of obuild (Config parsing, meta parsing, opam generation, dependencies analysis, building analysis,...) * replace Digest by a faster (and more modern) digest module from cryptohash * better portability (windows) * add a way to refresh a .mli from scratch. for example obuild generate-mli src/ext.ml will (re-)write src/ext.mli * add a simple way to switch stdlib so that core can be used instead of the compiler stdlib for any target. (project field parsing done already) * have test (re-)build themselves when doing obuild test, instead of doing 'obuild build; obuild test'. * improve command line experience (cmdliner ?) obuild-obuild-v0.1.10/bootstrap000077500000000000000000000060031327005302600164510ustar00rootroot00000000000000#!/usr/bin/env bash libs="unix.cmxa" OCAMLOPT="ocamlopt -g" # use faster ocamlopt, if available OCAMLOPT_OPT=`which ocamlopt.opt` if [[ $OCAMLOPT_OPT != "" ]] ; then OCAMLOPT="ocamlopt.opt -g" fi OCAMLVER=`$OCAMLOPT -vnum` echo $OCAMLVER rm -f ext/compat.ml if [[ $OCAMLVER < "4.02.0" ]] ; then echo "Using compat401.ml" cp -f compat401.ml ext/compat.ml else echo "Using compat402.ml" cp -f compat402.ml ext/compat.ml fi extmodules="compat fugue filepath filesystem" libmodules="types gconf filetype dag libname pp expr utils modname taskdep helper dagutils process findlibConf scheduler prog dependencies generators hier meta metacache target dist project analyze configure prepare buildprogs build exception" mainmodules="sdist doc init help install path_generated main" set -e ######################################################################## ######################################################################## ######################################################################## # build ext cd ext rm -f *.cmi *.cmx *.o APPEND="" for mod in $extmodules do echo "COMPILING $mod" [ -f ${mod}.mli ] && $OCAMLOPT -for-pack Ext -c ${mod}.mli $OCAMLOPT -for-pack Ext -c ${mod}.ml APPEND+="ext/${mod}.cmx " done; cd .. echo "BUILDING library obuild_ext.cmxa" $OCAMLOPT -pack -o ext.cmx -I ext/ $APPEND $OCAMLOPT -a -o obuild_ext.cmxa ext.cmx ######################################################################## ######################################################################## ######################################################################## # build the library cd obuild rm -f *.cmi *.cmx *.o APPEND="" for mod in $libmodules do echo "COMPILING $mod" [ -f ${mod}.mli ] && $OCAMLOPT -for-pack Obuild -I ../ -c ${mod}.mli $OCAMLOPT -for-pack Obuild -I ../ -c ${mod}.ml APPEND+="obuild/${mod}.cmx " done; cd .. echo "BUILDING library obuild.cmxa" $OCAMLOPT -pack -o obuild.cmx -I ext/ $APPEND $OCAMLOPT -a -o obuild.cmxa obuild.cmx # then bootstrap the main executable # main needs the version number cat < src/path_generated.ml (* autogenerated file by bootstrap. do not modify *) let project_version = "0.0.0" EOF cd src APPEND="" for mod in $mainmodules do echo "COMPILING $mod" [ -f ${mod}.mli ] && $OCAMLOPT -I ../ -c ${mod}.mli $OCAMLOPT -I ../ -c ${mod}.ml APPEND+="${mod}.cmx " done echo "LINKING obuild.bootstrap" $OCAMLOPT -o ../obuild.bootstrap -I ../ ${libs} obuild_ext.cmxa obuild.cmxa $APPEND cd .. rm -f obuild/*.cmi obuild/*.cmx obuild/*.o rm -f src/*.cmi src/*.cmx src/*.o rm -f *.cmi *.o *a *.cmx *.cmxa rm -f src/path_generated.ml ######################################################################## ######################################################################## ######################################################################## # rebuild everything with the bootstraped version export OCAMLRUNPARAM=b ./obuild.bootstrap clean ./obuild.bootstrap configure time ./obuild.bootstrap build if [ -x dist/build/obuild/obuild ]; then rm obuild.bootstrap fi obuild-obuild-v0.1.10/compat401.ml000066400000000000000000000005501327005302600165510ustar00rootroot00000000000000let bytes_of_string = String.copy let bytes_to_string = String.copy let bytes_make = String.make let bytes_create = String.create let bytes_get = String.get let bytes_set = String.set let bytes_length = String.length let bytes_index_from = String.index_from let buffer_add_subbytes = Buffer.add_substring obuild-obuild-v0.1.10/compat402.ml000066400000000000000000000005751327005302600165610ustar00rootroot00000000000000let bytes_of_string = Bytes.of_string let bytes_to_string = Bytes.to_string let bytes_make = Bytes.make let bytes_create = Bytes.create let bytes_get = Bytes.get let bytes_set = Bytes.set let bytes_length = Bytes.length let bytes_index_from = Bytes.index_from let buffer_add_subbytes = Buffer.add_subbytes obuild-obuild-v0.1.10/configure.ml000066400000000000000000000003201327005302600170150ustar00rootroot00000000000000let version = Sys.ocaml_version in ignore(Sys.command "rm -f ext/compat.ml"); if version < "4.02.0" then Sys.command "cp -f compat401.ml ext/compat.ml" else Sys.command "cp -f compat402.ml ext/compat.ml" obuild-obuild-v0.1.10/ext/000077500000000000000000000000001327005302600153075ustar00rootroot00000000000000obuild-obuild-v0.1.10/ext/filepath.ml000066400000000000000000000045071327005302600174430ustar00rootroot00000000000000open Fugue exception EmptyFilename exception InvalidFilename of string type filepath = { absolute: bool; filepath : string list } type filename = { filename : string } let emptyFn = { filename = "" } let currentDir = { absolute = false; filepath = [] } let fp_to_string x = match x.filepath, x.absolute with | ([], true) -> "/" | ([], false) -> "./" | (l, true) -> "/" ^ String.concat Filename.dir_sep l | (l, false) -> String.concat Filename.dir_sep l let fn_to_string x = x.filename let got_dirsep x = let gotDirsep = ref false in let dirsepLen = String.length (Filename.dir_sep) in for i = 0 to String.length x - dirsepLen - 1 do if String.sub x i dirsepLen = Filename.dir_sep then gotDirsep := true done; !gotDirsep (* this only strip the last / if it exists *) let fp x = (* TODO fix it properly, however separator is always a single char *) match string_split Filename.dir_sep.[0] x with | "" :: p -> { absolute = true; filepath = List.filter (fun x -> x <> "." && x <> "") p } | p -> { absolute = false; filepath = List.filter (fun x -> x <> "." && x <> "") p } let fn = function | "" | "." | ".." -> raise EmptyFilename | filename when got_dirsep filename -> raise (InvalidFilename filename) | filename -> { filename } let valid_fn x = try let _ = fn x in true with _ -> false let () (afp:filepath) (bfp:filepath) = match (afp.absolute, bfp.absolute) with | _, true -> failwith "the second argument cannot be an absolute path" | _ -> { absolute = afp.absolute; filepath = afp.filepath @ bfp.filepath } let () (afp:filepath) (bfp:filename) = { absolute = afp.absolute; filepath = afp.filepath @ [bfp.filename] } let (<.>) (afp:filename) ext = fn (afp.filename ^ "." ^ ext) let with_optpath mdir (filename : filename) = let path = match mdir with | None -> currentDir | Some dir -> dir in path filename let path_length path = List.length path.filepath let path_dirname path = { path with filepath = list_init path.filepath } let path_basename path = fn (list_last path.filepath) let path_parent path = path_dirname (path_dirname path) let in_current_dir (x:filename) = fp x.filename let chop_extension (x:filename) = fn (Filename.chop_extension (fn_to_string x)) obuild-obuild-v0.1.10/ext/filepath.mli000066400000000000000000000054411327005302600176120ustar00rootroot00000000000000(** The module [Filepath] defines two types, [filepath] and [filename] to represent paths and file names in a file system. * a [filepath] represent a path in a filesystem. It can be relative or absolute, and is composed of components. The last component can correspond to a directory or a file in a filesystem. Other components correspond to directories. * a [filename] encapsulate the name of a file. *) (** Exceptions *) (** [EmptyFilename] is raised by [fn] when trying to create a value of type [filename] out of strings "", "." or ".." *) exception EmptyFilename (** [InvalidFilename fn] is raised by [fn] when trying to create a value of type [filename] when [fn] contains [Filename.dir_sep]. *) exception InvalidFilename of string (** Types *) (** Type representing a path in a filesystem. *) type filepath (** Type representing a file in a filesystem. *) type filename (** Filename guaranteed to point to no valid file. Useful for initializing structures that have a field of type [filename]. *) val emptyFn : filename (** Filepath pointing to the current working directory. *) val currentDir : filepath (** Functions to convert the above types to and from string. *) val fp_to_string : filepath -> string val fn_to_string : filename -> string val fp : string -> filepath val fn : string -> filename (** [got_dirsep s] returns [true] if [s] contains [Filename.dir_sep], i.e. "/" on Unix. *) val got_dirsep : string -> bool (** [valid_fn s] returns [true] if [s] is a valid file name, i.e. not ".", "..", not containing [Filename.dir_sep]. *) val valid_fn : string -> bool (** [fp1 fp2] concatenate [fp2] to [fp1]. [fp2] cannot be an absolute path. *) val ( ) : filepath -> filepath -> filepath (** [fp fn] concatenate [fn] to [fp]. *) val ( ) : filepath -> filename -> filepath (** [fn <.> ext] appends the extension [ext] to [fn]. *) val ( <.> ) : filename -> string -> filename (** [with_optpath fp fn] is equivalent to [fp fn] if [fp <> None], otherwise equivalent to [currentDir fn]. *) val with_optpath : filepath option -> filename -> filepath (** [in_current_dir fn] is equivalent to [currentDir fn]. *) val in_current_dir : filename -> filepath (** [path_length fp] returns the number of components in [fp], including the last (basename) one. *) val path_length : filepath -> int (** Analogous to [Filename.dirname], but operate on [filepath]s. *) val path_dirname : filepath -> filepath (** Analogous to [Filename.basename], but operate on [filepath]s. *) val path_basename : filepath -> filename (** [path_parent fp] is equivalent to [path_dirname (path_dirname fp)]. *) val path_parent : filepath -> filepath (** Analogous to [Filename.chop_extension], but for [filename]s. *) val chop_extension : filename -> filename obuild-obuild-v0.1.10/ext/filesystem.ml000066400000000000000000000131541327005302600200310ustar00rootroot00000000000000open Printf open Fugue open Filepath open Compat exception UnexpectedFileType of string exception WriteFailed let removeDirContent wpath = let path = fp_to_string wpath in let rec rmdir_recursive f path = let dirhandle = Unix.opendir path in (try while true do let ent = Unix.readdir dirhandle in if String.length ent > 0 && ent.[0] <> '.' then let fent = path ^ Filename.dir_sep ^ ent in match (Unix.lstat fent).Unix.st_kind with | Unix.S_DIR -> rmdir_recursive (Unix.rmdir) fent | Unix.S_REG -> Unix.unlink fent | _ -> raise (UnexpectedFileType fent) done; with End_of_file -> () ); Unix.closedir dirhandle; f path in if Sys.file_exists path then rmdir_recursive (const ()) path let removeDir path = removeDirContent path; Unix.rmdir (fp_to_string path); () let iterate f path = let dirhandle = Unix.opendir (fp_to_string path) in (try while true do let ent = Unix.readdir dirhandle in if ent <> ".." && ent <> "." then f (fn ent) done; with End_of_file -> () ); Unix.closedir dirhandle; () (* list directory entry with a map function included for efficiency *) let list_dir_pred_map (p : filename -> 'a option) path : 'a list = let accum = ref [] in iterate (fun ent -> match p ent with | None -> () | Some e -> accum := e :: !accum ) path; !accum let list_dir_pred (p : filename -> bool) path : filename list = list_dir_pred_map (fun e -> if p e then Some e else None) path let list_dir = list_dir_pred (const true) let list_dir_path_pred p path = let accum = ref [] in let dirhandle = Unix.opendir (fp_to_string path) in (try while true do let ent = Unix.readdir dirhandle in if ent <> ".." && p ent then accum := (path fn ent) :: !accum done; with End_of_file -> () ); Unix.closedir dirhandle; !accum let list_dir_path = list_dir_path_pred (const true) let getModificationTime path = try (Unix.stat (fp_to_string path)).Unix.st_mtime with _ -> 0.0 let exists path = Sys.file_exists (fp_to_string path) let is_dir path = try Sys.is_directory (fp_to_string path) with _ -> false (* create a directory safely. * * return false if the directory already exists * return true if the directory has been created *) let mkdirSafe path perm = if Sys.file_exists (fp_to_string path) then (if Sys.is_directory (fp_to_string path) then false else failwith ("directory " ^ (fp_to_string path) ^ " cannot be created: file already exists")) else (Unix.mkdir (fp_to_string path) perm; true) let mkdirSafe_ path perm = let (_: bool) = mkdirSafe path perm in () let rec mkdirSafeRecursive path perm = if not (is_dir path) then ( if path_length path > 1 then ( mkdirSafeRecursive (path_dirname path) perm; mkdirSafe_ path perm ) ) let create_or_empty_dir path = let created = mkdirSafe path 0o755 in if not created then removeDirContent path; () let write_no_partial fd b o l = let len = ref l in let ofs = ref o in while !len > 0 do let written = Unix.write fd (bytes_of_string b) !ofs !len in if written = 0 then raise WriteFailed; ofs := !ofs + written; len := !len - written done let withfile path openflags perms f = let fd = Unix.openfile (fp_to_string path) openflags perms in finally (fun () -> f fd) (fun () -> Unix.close fd) let writeFile path s = withfile path [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o644 (fun fd -> write_no_partial fd s 0 (String.length s) ) let readFile path = let buf = Buffer.create 1024 in let b = bytes_make 1024 ' ' in withfile path [Unix.O_RDONLY] 0o644 (fun fd -> let isDone = ref false in while not !isDone do let r = Unix.read fd b 0 1024 in if r > 0 then buffer_add_subbytes buf b 0 r else isDone := true done; Buffer.contents buf ) let copy_file src dst = mkdirSafeRecursive (path_dirname dst) 0o755; let s = bytes_make 4096 ' ' in let srcStat = Unix.stat (fp_to_string src) in let operm = srcStat.Unix.st_perm in withfile dst [Unix.O_WRONLY; Unix.O_CREAT] operm (fun fdDst -> withfile src [Unix.O_RDONLY] 0o644 (fun fdSrc -> let isDone = ref false in while not !isDone do let r = Unix.read fdSrc s 0 4096 in if r > 0 then write_no_partial fdDst (bytes_to_string s) 0 r else isDone := true done ) ) let copy_to_dir src dst = copy_file src (dst src) let copy_many_files srcs dst = List.iter (fun src -> copy_to_dir src dst) srcs let rec mktemp_dir_in prefix = let s = bytes_make 4 ' ' in let fd = Unix.openfile "/dev/urandom" [Unix.O_RDONLY] 0o640 in let r = ref 0 in while !r < 4 do let n = Unix.read fd s !r (4 - !r) in if n = 0 then r := 4 (* should never happen, but even if it does, the getpid just provide basic randomness property *) else r := n + !r done; Unix.close fd; let s = bytes_to_string s in let tmpName = sprintf "%d-%02x%02x%02x%02x" (Unix.getpid ()) (Char.code s.[0]) (Char.code s.[1]) (Char.code s.[2]) (Char.code s.[3]) in let dirName = fp (prefix ^ tmpName) in let v = mkdirSafe dirName 0o755 in if v then dirName else mktemp_dir_in prefix obuild-obuild-v0.1.10/ext/filesystem.mli000066400000000000000000000104641327005302600202030ustar00rootroot00000000000000(** The module [Filesystem] contain helpers to browse and operate on files and directories of a file system. It uses the abstraction provided by the module [Filepath]. *) (** Exceptions *) (** Raised by [removeDirContent] whenever trying to delete a block or char device. *) exception UnexpectedFileType of string (** Raised by [write_no_partial]. *) exception WriteFailed (** Removes the contents of a directory. Raises [UnexpectedFileType] if the directory contain a file representing a block or a character device. *) val removeDirContent : Filepath.filepath -> unit (** Remove a directory and its content. *) val removeDir : Filepath.filepath -> unit (** [iterate f fp] calls [f] on each filename contained in [fp] (excluding "." and ".."). Note that a filename can represent either a file or a directory in the file system. *) val iterate : (Filepath.filename -> unit) -> Filepath.filepath -> unit (** [list_dir_pred_map f fp] applies [f] to each filename contained in [fp] using [iterate], and returns all elements that have been obtained when [f] did not return [None]. *) val list_dir_pred_map : (Filepath.filename -> 'a option) -> Filepath.filepath -> 'a list (** [list_dir_pred pred fp] returns a list of filenames (obtained with [iterate] that satisfy the predicate [pred]. *) val list_dir_pred : (Filepath.filename -> bool) -> Filepath.filepath -> Filepath.filename list (** [list_dir fp] returns the files (and directories) under [fp] (excluding "." and ".."). *) val list_dir : Filepath.filepath -> Filepath.filename list (** [list_dir_path_pred pred fp] returns the paths contained in [fp], including ".", that satisfy [pred]. *) val list_dir_path_pred : (string -> bool) -> Filepath.filepath -> Filepath.filepath list (** [list_dir_path fp] returns the paths contained in [fp], including ".".*) val list_dir_path : Filepath.filepath -> Filepath.filepath list (** Returns the modification time of a filepath, or returns [0.] if any error occured. *) val getModificationTime : Filepath.filepath -> float (** Analogous of [Sys.file_exists] but for a filepath *) val exists : Filepath.filepath -> bool (** Analogous of [Sys.is_directory] but for a filepath *) val is_dir : Filepath.filepath -> bool (** [mkdirSafe fp perms] creates a directory at [fp] unless a directory or a file already exists here. Return [false] if a directory already exists, [true] if the directory has just been created, and raise an exception [Failure] if a file already exists at this location. *) val mkdirSafe : Filepath.filepath -> Unix.file_perm -> bool (** Analogous to [ignore (mkdirSafe fp perms). *) val mkdirSafe_ : Filepath.filepath -> Unix.file_perm -> unit (** Recursively create directories with [mkdirSafe_] until the all directories on the filepath specified as argument exists. *) val mkdirSafeRecursive : Filepath.filepath -> Unix.file_perm -> unit (** [create_or_empty_dir fp] will create a directory at [fp]. If a directory already exists at [fp], remote its content. *) val create_or_empty_dir : Filepath.filepath -> unit (** [write_no_partial fd buf start len] writes [len] chars of [buf] starting at [start] in [fd], or raises [WriteFailed] if impossible. *) val write_no_partial : Unix.file_descr -> string -> int -> int -> unit (** [withfile fp flags perms f] opens the file at [fp] and apply [f] to the obtained file descriptor. *) val withfile : Filepath.filepath -> Unix.open_flag list -> Unix.file_perm -> (Unix.file_descr -> 'a) -> 'a (** Functions for writing/reading to/from a file in a filesystem. *) val writeFile : Filepath.filepath -> string -> unit val readFile : Filepath.filepath -> string (** Functions for copying files. *) (** [copy_file src dst] will copy file [src] to [dst]. *) val copy_file : Filepath.filepath -> Filepath.filepath -> unit (** [copy_to_dir src dst] fill copy file [src] in directory [dst]. *) val copy_to_dir : Filepath.filepath -> Filepath.filepath -> unit (** [copy_many_files srcs dst] will copy files [srcs] in the directory [dst]. *) val copy_many_files : Filepath.filepath list -> Filepath.filepath -> unit (** [mktemp_dir_in prefix] creates a temporary directory in the current working directory, whose name starts with [prefix] but is otherwise random. *) val mktemp_dir_in : string -> Filepath.filepath obuild-obuild-v0.1.10/ext/fugue.ml000066400000000000000000000136201327005302600167560ustar00rootroot00000000000000let finally fct clean_f = let result = try fct (); with exn -> clean_f (); raise exn in clean_f (); result let maybe d f v = match v with None -> d | Some x -> f x let may f v = maybe None (fun x -> Some (f x)) v let default d v = maybe d (fun x -> x) v let maybe_unit f v = maybe () f v let const v = (fun _ -> v) let rec maybes_to_list l = match l with | [] -> [] | None :: xs -> maybes_to_list xs | (Some x) :: xs -> x :: maybes_to_list xs type ('a,'b) either = Left of 'a | Right of 'b let ($) f a = f a let id = (fun x -> x) let char_is_alphanum c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') let string_index_pred p s = let len = String.length s in let i = ref 0 in while !i < len && not (p s.[!i]) do i := !i + 1 done; if !i == len then (raise Not_found) else !i let rec string_split ?limit:(limit=(-1)) c s = let i = try String.index s c with Not_found -> -1 in let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in if i = -1 || nlimit = 0 then [ s ] else let a = String.sub s 0 i and b = String.sub s (i + 1) (String.length s - i - 1) in a :: (string_split ~limit: nlimit c b) let rec string_split_pred ?limit:(limit=(-1)) p s = let i = try string_index_pred p s with Not_found -> -1 in let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in if i = -1 || nlimit = 0 then [ s ] else let a = String.sub s 0 i and b = String.sub s (i + 1) (String.length s - i - 1) in a :: (string_split_pred ~limit: nlimit p b) let string_startswith prefix x = let x_l = String.length x and prefix_l = String.length prefix in prefix_l <= x_l && String.sub x 0 prefix_l = prefix let string_endswith suffix x = Filename.check_suffix x suffix let string_stripPredicate p str = let len = String.length str in let s = ref 0 in let e = ref (String.length str) in while !s < len && p str.[!s] do s := !s + 1 done; let start = !s in while !e > start && p str.[!e-1] do e := !e - 1 done; String.sub str start (!e - start) let string_stripSpaces = string_stripPredicate (fun c -> c = ' ' || c = '\t' || c = '\n') let string_splitAt pos s = let len = String.length s in if pos > len then invalid_arg "splitAt" else (String.sub s 0 pos, String.sub s pos (len - pos)) let string_take n s = let len = String.length s in if n > len then invalid_arg "String.take" else String.sub s 0 n let string_drop n s = let len = String.length s in if n > len then invalid_arg "String.drop" else String.sub s n (len - n) let string_init n s = let len = String.length s in if n > len then invalid_arg "String.init" else String.sub s 0 (len - n) let string_all p s = let len = String.length s in let rec loop i = if i = len then true else (if not (p s.[i]) then false else loop (i+1)) in loop 0 let string_lines s = string_split '\n' s let string_words s = string_split_pred (fun c -> c = ' ' || c = '\n' || c = '\t') s let no_empty emptyVal = List.filter (fun x -> x <> emptyVal) let string_words_noempty s = no_empty "" (string_words s) let string_lines_noempty s = no_empty "" (string_lines s) let list_singleton = fun x -> [x] let rec list_init l = match l with | [] -> failwith "init empty list" | [_] -> [] | x::xs -> x :: list_init xs let rec list_last l = match l with | [] -> failwith "last is empty" | [x] -> x | _::xs -> list_last xs let list_remove e list = List.filter (fun x -> x <> e) list let list_iteri f list = let rec loop i l = match l with | [] -> () | x::xs -> f i x; loop (i+1) xs in loop 1 list let list_eq_noorder (l1: 'a list) (l2: 'a list) : bool = List.for_all (fun z -> List.mem z l2) l1 let list_filter_map (f: 'a -> 'b option) (l: 'a list) : 'b list = let rec loop (z: 'a list) : 'b list = match z with | [] -> [] | x::xs -> match f x with | None -> loop xs | Some y -> y :: loop xs in loop l let list_mem_many needles haystack = let rec loop l = match l with | [] -> false | x::xs -> if List.mem x needles then true else loop xs in loop haystack let rec list_uniq l = match l with | [] -> [] | x::xs -> if List.mem x xs then list_uniq xs else x :: list_uniq xs let rec list_findmap p l = match l with | [] -> raise Not_found | x::xs -> match p x with | Some z -> z | None -> list_findmap p xs let hashtbl_map f h = let newh = Hashtbl.create (Hashtbl.length h) in Hashtbl.iter (fun k v -> Hashtbl.add newh k (f v)) h; newh let hashtbl_keys h = Hashtbl.fold (fun k _ l -> k :: l) h [] let hashtbl_modify_one f k h = let v = Hashtbl.find h k in Hashtbl.replace h k (f v) let hashtbl_modify_all f h = let keys = hashtbl_keys h in List.iter (fun k -> let v = Hashtbl.find h k in Hashtbl.replace h k (f v) ) keys let hashtbl_fromList l = let h = Hashtbl.create (List.length l) in List.iter (fun (k,v) -> Hashtbl.add h k v) l; h let hashtbl_toList h = Hashtbl.fold (fun k v l -> (k,v)::l) h [] let first f (a,b) = (f a, b) let second f (a,b) = (a, f b) exception ConversionIntFailed of string * string exception ConversionBoolFailed of string * string let user_int_of_string loc s = try int_of_string s with _ -> raise (ConversionIntFailed (loc,s)) let user_bool_of_string loc s = try bool_of_string s with _ -> raise (ConversionBoolFailed (loc,s)) module StringSet = struct include Set.Make(struct type t = string let compare = Pervasives.compare end) let to_list t = fold (fun elt l -> elt::l) t [] end obuild-obuild-v0.1.10/obuild.install000066400000000000000000000001211327005302600173470ustar00rootroot00000000000000bin: [ "dist/build/obuild/obuild" "dist/build/obuild-simple/obuild-simple" ] obuild-obuild-v0.1.10/obuild.obuild000066400000000000000000000042031327005302600171640ustar00rootroot00000000000000name: obuild version: 0.1.9 synopsis: Simple declarative build system for OCaml. description: o'build o'build ye source . simple declarative build system for OCaml license: BSD license-file: LICENSE authors: Vincent Hanquez , Jerome Maloberti obuild-ver: 1 configure-script: configure.ml homepage: http://github.com/ocaml-obuild/obuild ocaml-extra-args: -w A extra-srcs: bootstrap , tests/full/dep-uri/p2.obuild , tests/full/autogenerated/p3.obuild , tests/full/autopack/autopack.obuild , tests/full/with-c/ccall.obuild , tests/full/with-c/cbits.c , tests/full/with-c/ccall.ml , tests/full/dep-uri/p2.ml , tests/full/autogenerated/p3.ml , tests/full/autopack/src/main.ml , tests/full/autopack/src/b/a.ml , tests/full/autopack/src/b/c.ml , tests/full/autopack/src/a.ml , tests/full/parser/main.ml , tests/full/parser/parser.obuild , tests/full/parser/rpncalc.mly , tests/full/parser/lexer.mll , tests/full/simple/p1.obuild , tests/full/simple/p1.ml , tests/full/run , tests/simple/gtk.ml , tests/simple/z.ml , tests/simple/hello_world.ml , tests/simple/run , tests/simple/z.build , tests/simple/gtk.build , tests/simple/hello_world.build , tests/simple/z_stubs.c , tests/simple/gtk_stubs.c , README.md , DESIGN.md , TODO.md library obuild modules: obuild build-deps: unix, obuild.ext library ext modules: ext build-deps: unix # a comment executable obuild main-is: main.ml src-dir: src build-deps: unix, obuild executable obuild-simple main-is: simple.ml src-dir: src build-deps: unix, obuild executable obuild-from-oasis main-is: assimilate_oasis.ml src-dir: tools build-deps: obuild, obuild.ext installable: false test dag src-dir: tests main-is: test_dag.ml build-deps: obuild test path src-dir: tests main-is: test_path.ml build-deps: obuild, obuild.ext test expr src-dir: tests main-is: test_expr.ml build-deps: obuild, obuild.ext test find src-dir: tests main-is: test_find.ml build-deps: obuild, obuild.ext obuild-obuild-v0.1.10/obuild/000077500000000000000000000000001327005302600157655ustar00rootroot00000000000000obuild-obuild-v0.1.10/obuild/analyze.ml000066400000000000000000000261521327005302600177700ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext open Helper open Printf open Gconf open Target open Dependencies exception SublibraryDoesntExists of Libname.t exception OcamlConfigMissing of string (* differentiate if the dependency is system or is internal to the project *) type dep_type = System | Internal type dependency_tag = Target of Name.t | Dependency of Libname.t type cpkg_config = { cpkg_conf_libs : string list ; cpkg_conf_includes : filepath list } (* this is a read only config of the project for configuring and building. *) type project_config = { project_dep_data : (Libname.t, dep_type) Hashtbl.t ; project_pkgdeps_dag : dependency_tag Dag.t ; project_targets_dag : Name.t Dag.t ; project_all_deps : dependency list ; project_file : Project.t ; project_ocamlcfg : (string, string) Hashtbl.t ; project_ocamlmkcfg : (string, string) Hashtbl.t ; project_cpkgs : (string, cpkg_config) Hashtbl.t } let get_ocaml_config_key_hashtbl key h = try Hashtbl.find h key with Not_found -> raise (OcamlConfigMissing key) let getOcamlConfigKey key = get_ocaml_config_key_hashtbl key (Prog.getOcamlConfig ()) let get_ocaml_config_key key project = get_ocaml_config_key_hashtbl key project.project_ocamlcfg let get_pkg_deps target project = let pkgs = Taskdep.linearize project.project_pkgdeps_dag Taskdep.FromParent [Target target.target_name] in List.rev (list_filter_map (fun pkg -> match pkg with Dependency d -> Some d | Target _ -> None) pkgs) let get_c_pkg cname project = try Hashtbl.find project.project_cpkgs cname with Not_found -> failwith (sprintf "C package %s not found in the hashtbl: internal error" cname) let is_pkg_internal project pkg = Hashtbl.find project.project_dep_data pkg = Internal let is_pkg_system project pkg = Hashtbl.find project.project_dep_data pkg = System let get_internal_library_deps project target = let internalDeps = Dag.getChildren project.project_targets_dag target.target_name in list_filter_map (fun name -> match name with | Name.Lib lname -> Some lname | _ -> None ) internalDeps (* all the standard libraries shipped with ocaml, comes *without* META files, so * we pre-populate the META cache with whatever we need by scanning the * directory that ocaml use as standard_library (found by running ocamlc -config). * * it allows to bootstrap better when ocamlfind has not been yet installed or * to detect difference of opinions of where the stdlib is, between ocamlfind and ocamlc. *) let initializeSystemStdlib ocamlCfg = let ocaml_ver = Hashtbl.find (Prog.getOcamlConfig ()) "version" in let stdlibPath = fp (get_ocaml_config_key_hashtbl "standard_library" ocamlCfg) in let stdlibLibs = Filesystem.list_dir_pred_map (fun n -> let ext = Filetype.of_filename n in if ext = Filetype.FileCMXA || ext = Filetype.FileCMA then Some n else None ) stdlibPath in let libs = list_uniq $ List.map (fun f -> fn_to_string $ Filepath.chop_extension f) stdlibLibs in List.iter (fun lib -> (* skip .p library which are just variant of the no .p library *) if not (string_endswith ".p" lib) then ( verbose Verbose "initializing standard library : package %s\n" lib; let libCmxa = lib ^ ".cmxa" in let libCma = lib ^ ".cma" in let archives = (if List.mem (fn libCmxa) stdlibLibs then [([Meta.Predicate.Native], libCmxa)] else []) @ (if List.mem (fn libCma) stdlibLibs then [([Meta.Predicate.Byte], libCma)] else []) in let meta = { (Meta.Pkg.make lib) with Meta.Pkg.directory = fp_to_string stdlibPath ; Meta.Pkg.requires = [] (* AFAIK this is always empty for stdlibs *) ; Meta.Pkg.version = ocaml_ver ; Meta.Pkg.archives = archives } in Metacache.add lib (stdlibPath fn ("META-" ^ lib), meta) ) ) libs let readOcamlMkConfig filename = let lines = Utils.read_file_with (function "" -> None | s when s.[0] = '#' -> None | s -> Some s) (filename ^ "/Makefile.config") in let h = Hashtbl.create 32 in List.iter (fun l -> let (k,v) = Utils.toKVeq l in Hashtbl.add h (String.lowercase k) (default "" v) ) lines; h (* get all the dependencies required * and prepare the global bstate.of value *) let prepare projFile user_flags = verbose Verbose "analyzing project\n%!"; let ocamlCfg = Prog.getOcamlConfig () in let ocamlMkCfg = readOcamlMkConfig (Hashtbl.find ocamlCfg "standard_library") in let depsTable = Hashtbl.create 16 in let cpkgsTable = Hashtbl.create 1 in let depsDag = Dag.init () in let targetsDag = Dag.init () in let missingDeps = ref StringSet.empty in initializeSystemStdlib ocamlCfg; (* check for findlib / ocaml configuration mismatch *) let () = let stdlibPath = fp (get_ocaml_config_key_hashtbl "standard_library" ocamlCfg) in if not (List.exists (fun p -> string_startswith (fp_to_string p) (fp_to_string stdlibPath)) (FindlibConf.get_paths ())) then ( Meta.path_warning := true ) in let allTargets = Project.get_all_buildable_targets projFile user_flags in let internalLibs = List.map (fun lib -> lib.Project.Library.name.Libname.main_name) projFile.Project.libs in let isInternal lib = List.mem lib.Libname.main_name internalLibs in (* establish inter-dependencies in the project. * only consider internal libraries *) List.iter (fun target -> Dag.addNode target.target_name targetsDag; List.iter (fun (dep, _) -> if isInternal dep then ( verbose Debug " internal depends: %s\n" (Libname.to_string dep); Dag.addEdge target.target_name (Name.Lib dep) targetsDag; ) ) (Target.get_all_builddeps target); ) allTargets; let add_missing dep = missingDeps := StringSet.add dep (!missingDeps) in (* load every dependencies META files and at the same time generate the * graph of inter-dependencies. * * This recursively load all dependencies and dependencies's dependencies. *) let rec loop dep = let dataDep () = if isInternal dep then ( let iLib = Project.find_lib projFile dep in let iLibDep = Dependency iLib.Project.Library.name in Dag.addNode iLibDep depsDag; List.iter (fun (reqDep,_) -> verbose Debug " library %s depends on %s\n" (Libname.to_string iLib.Project.Library.name) (Libname.to_string reqDep); Dag.addEdge iLibDep (Dependency reqDep) depsDag; loop reqDep ) iLib.Project.Library.target.target_obits.target_builddeps; Internal ) else ( try begin let (_, meta) = Metacache.get dep.Libname.main_name in Dag.addNode (Dependency dep) depsDag; let pkg = try Meta.Pkg.find dep.Libname.subnames meta with Not_found -> raise (SublibraryDoesntExists dep) | Meta.SubpackageNotFound _ -> raise (SublibraryDoesntExists dep) in List.iter (fun (preds, reqDeps) -> match preds with | [Meta.Predicate.Toploop] -> () | _ -> List.iter (fun reqDep -> verbose Debug " library %s depends on %s\n" (Libname.to_string dep) (Libname.to_string reqDep); Dag.addEdge (Dependency dep) (Dependency reqDep) depsDag; loop reqDep ) reqDeps ) pkg.Meta.Pkg.requires; System end with DependencyMissing dep -> (add_missing dep; System) ) in if not (Hashtbl.mem depsTable dep) then ( Hashtbl.add depsTable dep (dataDep ()) ); () in List.iter (fun target -> verbose Debug " getting dependencies for target %s\n%!" (Target.get_target_name target); let nodeTarget = Target target.target_name in Dag.addNode nodeTarget depsDag; (* if a lib, then we insert ourself as dependency for executable or other library *) let insertEdgeForDependency = (match target.target_name with | Name.Lib l -> Dag.addNode (Dependency l) depsDag; Dag.addEdge (Dependency l) | _ -> fun _ _ -> () ) in List.iter (fun (dep,constr) -> maybe_unit (fun c -> let (_,pkg) = Metacache.get dep.Libname.main_name in if not (Expr.eval pkg.Meta.Pkg.version c) then raise (Dependencies.BuildDepAnalyzeFailed (Libname.to_string dep ^ " (" ^ pkg.Meta.Pkg.version ^ ") doesn't match the constraint " ^ (Expr.to_string c))) ) constr; Dag.addEdge nodeTarget (Dependency dep) depsDag; insertEdgeForDependency (Dependency dep) depsDag; loop dep; ) (Target.get_all_builddeps target); if not (StringSet.is_empty !missingDeps) then raise (DependenciesMissing (StringSet.to_list !missingDeps)); List.iter (fun (cpkg, cconstr) -> let ver = Prog.runPkgConfigVersion cpkg in (* TODO compare the constraints *) ignore cconstr; ignore ver; let pkgIncludes = List.map fp (Prog.runPkgConfigIncludes cpkg) in let pkgLibs = Prog.runPkgConfigLibs cpkg in let pkgConf = { cpkg_conf_libs = pkgLibs; cpkg_conf_includes = pkgIncludes } in Hashtbl.add cpkgsTable cpkg pkgConf ) target.target_cbits.target_cpkgs ) allTargets; if gconf.dump_dot then ( let dotDir = Dist.create_build Dist.Dot in let path = dotDir fn "dependencies.dot" in let toString t = match t with | Target s -> "target(" ^ Name.to_string s ^ ")" | Dependency s -> Libname.to_string s in let dotContent = Dag.toDot toString "dependencies" true depsDag in Filesystem.writeFile path dotContent; let ipath = dotDir fn "internal-dependencies.dot" in let dotIContent = Dag.toDot Name.to_string "internal-dependencies" true targetsDag in Filesystem.writeFile ipath dotIContent; ); { project_dep_data = depsTable ; project_pkgdeps_dag = depsDag ; project_targets_dag = targetsDag ; project_all_deps = List.concat $ List.map (fun target -> target.target_obits.target_builddeps) allTargets ; project_ocamlcfg = ocamlCfg ; project_ocamlmkcfg = ocamlMkCfg ; project_file = projFile ; project_cpkgs = cpkgsTable } obuild-obuild-v0.1.10/obuild/build.ml000066400000000000000000000631301327005302600174210ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext open Types open Helper open Printf open Analyze open Target open Prepare open Gconf open Buildprogs exception CCompilationFailed of string exception CompilationFailed of string exception Internal_Inconsistancy of string * string (* check that destination is valid (mtime wise) against a list of srcs and * if not valid gives the filepath that has changed. * *) let check_destination_valid_with srcs (_, dest) = if Filesystem.exists dest then ( let dest_time = Filesystem.getModificationTime dest in try Some (List.find (fun (_,path) -> let mtime = Filesystem.getModificationTime path in dest_time < mtime ) srcs) with Not_found -> None ) else Some (Filetype.FileO, currentDir) (* same as before but the list of sources is automatically determined * from the file DAG *) let check_destination_valid cstate (filety, dest) = let children = try Dag.getChildren cstate.compilation_filesdag (Filetype.make_id (filety, dest)) with Dag.DagNode_Not_found -> raise (Internal_Inconsistancy ((Filetype.to_string filety), ("missing destination: " ^ fp_to_string dest))) in check_destination_valid_with (List.map Filetype.get_id children) (filety,dest) (* get a nice reason of why a destination is not deemed valid against * the source filepath that triggered the unvalid check. * * if source filepath is empty, it means that destination doesn't exists *) let reason_from_paths (_,dest) (srcTy,changedSrc) = let trim_pd_exts z = let n = fn_to_string z in if string_endswith ".d" n then fn (Filename.chop_suffix n ".d") else if string_endswith ".p" n then fn (Filename.chop_suffix n ".p") else z in if changedSrc = currentDir then "" else ( let bdest = path_basename dest in let bsrc = path_basename changedSrc in match Filetype.of_filename bdest with | Filetype.FileCMX | Filetype.FileCMO -> ( match srcTy with | Filetype.FileCMX | Filetype.FileCMO -> let bml = Filetype.replace_extension bdest Filetype.FileML in let bmli = Filetype.replace_extension bdest Filetype.FileMLI in if bml = bsrc then "Source changed" else if bmli = bsrc then "Interface changed" else ("Dependency " ^ Modname.to_string (Modname.of_filename (trim_pd_exts bsrc)) ^ " changed " ^ fp_to_string changedSrc) | Filetype.FileCMXA | Filetype.FileCMA -> "Library changed " ^ fp_to_string changedSrc | _ -> "Dependencies changed " ^ fp_to_string changedSrc ) | Filetype.FileO -> let bc = Filetype.replace_extension bdest Filetype.FileC in let bh = Filetype.replace_extension bdest Filetype.FileH in if bc = bsrc then ("C file " ^ fn_to_string bsrc ^ " changed") else if bh = bsrc then ("H file " ^ fn_to_string bsrc ^ " changed") else ("file changed " ^ fp_to_string changedSrc) | _ -> fp_to_string changedSrc ^ " changed" ) let get_all_modes target = let compile_opts = Target.get_compilation_opts target in let compiled_types = Target.get_ocaml_compiled_types target in let all_modes = List.concat (List.map (fun ty -> List.map (fun cmode -> (ty, cmode)) compile_opts) compiled_types) in List.filter (fun (t,o) -> match (t,o) with (ByteCode,WithProf) -> false | _ -> true) all_modes let annot_mode () = if (Gconf.get_target_option "annot") && gconf.bin_annot then AnnotationBoth else if (Gconf.get_target_option "annot") then AnnotationText else if gconf.bin_annot then AnnotationBin else AnnotationNone let get_nb_step dag = let nb_step = Dag.length dag in let nb_step_len = String.length (string_of_int nb_step) in (nb_step, nb_step_len) let buildmode_to_filety bmode = if bmode = Native then Filetype.FileCMX else Filetype.FileCMO let buildmode_to_library_filety bmode = if bmode = Native then Filetype.FileCMXA else Filetype.FileCMA let internal_libs_paths self_deps = List.map (fun (compile_opt,compile_type) -> ((compile_opt,compile_type), List.map (fun dep -> let dirname = Dist.get_build_exn (Dist.Target (Name.Lib dep)) in let filety = buildmode_to_library_filety compile_type in let libpath = dirname Libname.to_cmca compile_type compile_opt dep in (filety, libpath) ) self_deps) ) [ (Normal,Native);(Normal,ByteCode);(WithProf,Native);(WithProf,ByteCode);(WithDebug,Native);(WithDebug,ByteCode)] (* compile C files *) let compile_c task_index task c_file bstate task_context dag = let (cstate,target) = Hashtbl.find task_context task in let cbits = target.target_cbits in let c_dir_spec = { include_dirs = cstate.compilation_c_include_paths; dst_dir = cstate.compilation_builddir_c; src_dir = cbits.target_cdir } in let dest = (Filetype.FileO, c_dir_spec.dst_dir o_from_cfile c_file) in (match check_destination_valid cstate dest with | None -> Scheduler.FinishTask task | Some src_changed -> let reason = reason_from_paths dest src_changed in let (nb_step,nb_step_len) = get_nb_step dag in verbose Report "[%*d of %d] Compiling C %-30s%s\n%!" nb_step_len task_index nb_step (fn_to_string c_file) (if reason <> "" then " ( " ^ reason ^ " )" else ""); let cflags = cbits.target_cflags in Scheduler.AddProcess (task, runCCompile bstate.bstate_config c_dir_spec cflags c_file) ) (* compile a set of modules in directory into a pack *) let compile_directory task_index task (h : Hier.t) task_context dag = let (cstate,target) = Hashtbl.find task_context task in let pack_opt = Hier.parent h in (* get all the modules defined at level h+1 *) let modules_task = Taskdep.linearize cstate.compilation_dag Taskdep.FromParent [task] in let filter_modules t : Hier.t option = match t with | (CompileC _) | (LinkTarget _) | (CheckTarget _) -> None | (CompileDirectory m) | (CompileModule m) -> if Hier.lvl m = (Hier.lvl h + 1) then Some m else None | (CompileInterface m) -> if Hier.lvl m = (Hier.lvl h + 1) then begin let fe = Hier.get_file_entry_maybe m in match fe with None -> None | Some e -> match e with Hier.FileEntry (_, f) -> if (Filetype.of_filepath f) = Filetype.FileMLI then Some m else None | _ -> None end else None in let modules = List.rev $ list_filter_map filter_modules modules_task in let all_modes = get_all_modes target in let annot_mode = annot_mode () in (* directory never have interface (?) so we serialize the native/bytecode creation. * the mtime checking is sub-optimal. low hanging fruits warning *) let tasks_ops : (string * Scheduler.call) option list list = let (byte_list,native_list) = List.partition (fun (t,_) -> t = ByteCode) all_modes in (List.map (fun pair_list -> List.map (fun (build_mode, comp_opt) -> let path = cstate.compilation_builddir_ml comp_opt in let dest = (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI h) in let mdeps = List.map (fun m -> (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI m) ) modules in let dir = cstate.compilation_builddir_ml comp_opt in let fcompile = (fun () -> runOcamlPack dir dir annot_mode build_mode pack_opt h modules) in match check_destination_valid_with mdeps dest with | None -> None | Some src_changed -> Some (reason_from_paths dest src_changed, fcompile) ) pair_list ) [byte_list; native_list]) in let (reason, ops) = (*[ [(r,f)] ]*) let l : (string * Scheduler.call) list list = List.map maybes_to_list tasks_ops in match List.filter (fun x -> x <> []) l with | [] -> ("", []) | [] :: _ -> assert false | ((r,x)::xs) :: ys -> (r, (x :: List.map snd xs) :: List.map (List.map snd) ys) in if ops <> [] then ( let (nb_step,nb_step_len) = get_nb_step dag in verbose Report "[%*d of %d] Packing %-30s%s\n%!" nb_step_len task_index nb_step (Hier.to_string h) reason; Scheduler.AddTask (task, ops) ) else Scheduler.FinishTask task let dep_descs is_intf hdesc bstate cstate target h = let self_deps = Analyze.get_internal_library_deps bstate.bstate_config target in let internal_libs_paths_all_modes = internal_libs_paths self_deps in let module_deps = hdesc.Module.File.dep_cwd_modules in let compile_opts = Target.get_compilation_opts target in let all_modes = get_all_modes target in if is_intf then ( let intf_desc = match hdesc.Module.File.intf_desc with | None -> failwith "assertion error, task interface and no module_intf" | Some intf -> intf in List.map (fun comp_opt -> let path = cstate.compilation_builddir_ml comp_opt in let dest = (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI h) in let src = [ (Filetype.FileMLI, intf_desc.Module.Intf.path) ] in let m_deps = List.map (fun module_dep -> (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI module_dep)) module_deps in let internal_deps = List.assoc (comp_opt,ByteCode) internal_libs_paths_all_modes in (dest,Interface,comp_opt, src @ internal_deps @ m_deps) ) compile_opts ) else ( List.map (fun (compiled_ty, comp_opt) -> let file_compile_ty = buildmode_to_filety compiled_ty in let ext = if compiled_ty = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let path = cstate.compilation_builddir_ml comp_opt in let dest = (file_compile_ty, Hier.get_dest_file path ext h) in let src = (match hdesc.Module.File.intf_desc with None -> [] | Some intf -> [Filetype.FileMLI,intf.Module.Intf.path]) @ [(Filetype.FileML, hdesc.Module.File.path)] in let m_deps = List.concat (List.map (fun module_dep -> [(file_compile_ty, Hier.get_dest_file path ext module_dep); (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI module_dep)] ) module_deps) in let internal_deps = List.assoc (comp_opt,compiled_ty) internal_libs_paths_all_modes in (dest,Compiled compiled_ty,comp_opt,src @ internal_deps @ m_deps) ) all_modes ) (* add a OCaml module or interface compilation process *) let compile_module task_index task is_intf h bstate task_context dag = let all = Hashtbl.find_all task_context task in let process_one_target cstate target = let pack_opt = Hier.parent h in let hdesc = let desc = Hashtbl.find cstate.compilation_modules h in match desc with | Module.DescFile z -> z | Module.DescDir _ -> failwith (sprintf "internal error compile module on directory (%s). steps dag internal error" (Hier.to_string h)) in let src_path = path_dirname hdesc.Module.File.path in let use_thread = hdesc.Module.File.use_threads in let dir_spec = { src_dir = src_path; dst_dir = currentDir; include_dirs = [currentDir] } in let dep_descs = dep_descs is_intf hdesc bstate cstate target h in let annot_mode = annot_mode () in let rec check invalid descs = match descs with | [] -> (None, []) | (dest,build_mode,comp_opt,srcs) :: xs -> let r_dir_spec = { dir_spec with dst_dir = cstate.compilation_builddir_ml comp_opt Hier.to_dirpath h; include_dirs = cstate.compilation_include_paths comp_opt h } in let fcompile = (build_mode,(fun () -> runOcamlCompile r_dir_spec use_thread annot_mode build_mode comp_opt pack_opt hdesc.Module.File.use_pp hdesc.Module.File.oflags h)) in if invalid then ( let (_, ys) = check invalid xs in (Some "", fcompile :: ys) ) else ( match check_destination_valid_with srcs dest with | None -> check false xs | Some src_changed -> let reason = reason_from_paths dest src_changed in let (_, ys) = check true xs in (Some reason, fcompile :: ys) ) in (check false dep_descs, hdesc) in let all = List.map (fun (c,t) -> process_one_target c t) all in let ((compilation_reason, _), _) = List.hd all in match compilation_reason with | None -> Scheduler.FinishTask task | Some reason -> (* if the module has an interface, we create one list, so everything can be run in parallel, * otherwise we partition the build_mode functions in build_modes group. *) let fun_lists check_fun_list hdesc = if is_intf || Module.file_has_interface hdesc then [List.map snd check_fun_list] else let (l1,l2) = List.partition (fun (x,_) -> x = Compiled Native) check_fun_list in List.filter (fun x -> List.length x > 0) [List.map snd l1; List.map snd l2] in let all_fun_lists = List.fold_left (fun l ((_,check), hdesc) -> let funlist = fun_lists check hdesc in l @ funlist) [] all in let verb = if is_intf then "Intfing" else "Compiling" in let (nb_step, nb_step_len) = get_nb_step dag in verbose Report "[%*d of %d] %s %-30s%s\n%!" nb_step_len task_index nb_step verb (Hier.to_string h) (if reason <> "" then " ( " ^ reason ^ " )" else ""); Scheduler.AddTask (task, all_fun_lists) let wait_for_files cdep_files = List.for_all (fun f -> let test = Filesystem.exists f in if not test then verbose Debug "warning: (temporarily?) missing file %s" (fp_to_string f); test ) cdep_files let link_c cstate clib_name = let lib_name = cstate.compilation_builddir_c fn clib_name in let cdep_files = List.map (fun x -> cstate.compilation_builddir_c o_from_cfile x) cstate.compilation_csources in (* Not sure why it is necessary ... gcc seems to return before the files are ready. *) while not (wait_for_files cdep_files) do ignore (Unix.select [] [] [] 0.02) (* sleep 1/50 second *) done; if gconf.ocamlmklib then [[(fun () -> runCLinking LinkingShared cdep_files lib_name)]] else ( let so_file = cstate.compilation_builddir_c fn ("dll" ^ clib_name ^ ".so") in let a_file = cstate.compilation_builddir_c fn ("lib" ^ clib_name ^ ".a") in [[(fun () -> runCLinking LinkingShared cdep_files so_file)]; [(fun () -> runAr a_file cdep_files)]; [(fun () -> runRanlib a_file)]] ) let link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs compiledType compileOpt plugin = let systhread = Analyze.getOcamlConfigKey "systhread_supported" in let buildDeps = if is_lib target then [] else List.flatten (List.map (fun dep -> match Hashtbl.find bstate.bstate_config.project_dep_data dep with | Internal -> [(in_current_dir (Libname.to_cmca compiledType compileOpt dep))] | System -> let meta = Metacache.get_from_cache dep in let pred = match compiledType with | Native -> Meta.Predicate.Native | ByteCode -> Meta.Predicate.Byte in let preds = match useThreadLib with | PosixThread -> [ pred; Meta.Predicate.Mt; Meta.Predicate.Mt_posix] | VMThread -> [ pred; Meta.Predicate.Mt; Meta.Predicate.Mt_vm] | DefaultThread -> (if systhread = "true" then Meta.Predicate.Mt_posix else Meta.Predicate.Mt_vm) :: [ pred; Meta.Predicate.Mt] | NoThreads -> [ pred ] in let preds = match compileOpt with | WithProf -> Meta.Predicate.Gprof :: preds | _ -> preds in let archives = Meta.Pkg.get_archive_with_filter meta dep preds in List.fold_left (fun acc (_,a) -> let files = string_split ' ' a in acc @ (List.map (fun f -> in_current_dir $ fn f) files) ) [] archives ) pkgDeps) in let dest = match target.target_name with | Name.Lib libname -> if plugin then cstate.compilation_builddir_ml Normal Libname.to_cmxs compileOpt libname else cstate.compilation_builddir_ml Normal Libname.to_cmca compiledType compileOpt libname | _ -> let outputName = Utils.to_exe_name compileOpt compiledType (Target.get_target_dest_name target) in cstate.compilation_builddir_ml Normal outputName in let linking_paths_of compileOpt = match compileOpt with | Normal -> cstate.compilation_linking_paths | WithDebug -> cstate.compilation_linking_paths_d | WithProf -> cstate.compilation_linking_paths_p in let destTime = Filesystem.getModificationTime dest in let ext = if compiledType = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let path = cstate.compilation_builddir_ml compileOpt in let depsTime = try Some (List.find (fun p -> destTime < Filesystem.getModificationTime p) (List.map (fun m -> Hier.get_dest_file path ext m) compiled)) with Not_found -> None in if depsTime <> None then ( let (nb_step,nb_step_len) = get_nb_step dag in let link_type = if plugin then LinkingPlugin else if is_lib target then LinkingLibrary else LinkingExecutable in verbose Report "[%*d of %d] Linking %s %s\n%!" nb_step_len task_index nb_step (if is_lib target then "library" else "executable") (fp_to_string dest); [(fun () -> runOcamlLinking (linking_paths_of compileOpt) compiledType link_type compileOpt useThreadLib systhread cclibs buildDeps compiled dest)] ) else [] let link task_index task bstate task_context dag = let (cstate,target) = Hashtbl.find task_context task in let cbits = target.target_cbits in let compiled = get_compilation_order cstate in verbose Debug " compilation order: %s\n" (Utils.showList "," Hier.to_string compiled); let selfDeps = Analyze.get_internal_library_deps bstate.bstate_config target in verbose Debug " self deps: %s\n" (Utils.showList "," Libname.to_string selfDeps); let selfLibDirs = List.map (fun dep -> Dist.get_build_exn (Dist.Target (Name.Lib dep))) selfDeps in let internal_cclibs = if cstate.compilation_csources <> [] then [Target.get_target_clibname target] else [] in let cclibs = List.concat (List.map (fun (cpkg,_) -> List.map (fun x -> "-l" ^ x) (Analyze.get_c_pkg cpkg bstate.bstate_config).cpkg_conf_libs) cbits.target_cpkgs) @ List.map (fun x -> "-L" ^ fp_to_string x) selfLibDirs @ List.map (fun x -> "-l" ^ x) (cbits.target_clibs @ internal_cclibs) in let pkgDeps = Analyze.get_pkg_deps target bstate.bstate_config in verbose Verbose "package deps: [%s]\n" (Utils.showList "," Libname.to_string pkgDeps); let useThreadLib = if List.mem (Libname.of_string "threads") pkgDeps then DefaultThread else if List.mem (Libname.of_string "threads.posix") pkgDeps then PosixThread else if List.mem (Libname.of_string "threads.vm") pkgDeps then VMThread else NoThreads in let cfunlist = if cstate.compilation_csources <> [] then link_c cstate (Target.get_target_clibname target) else [] in let all_modes = get_all_modes target in let funlist = List.fold_left (fun flist (compiledType,compileOpt) -> let normal = (link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs compiledType compileOpt false) in let res = if (is_lib target) && compiledType = Native && (Gconf.get_target_option "library-plugin") then (link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs compiledType compileOpt true) @ normal else normal in res @ flist ) [] all_modes in if funlist <> [] then Scheduler.AddTask (task, cfunlist @ [funlist]) else Scheduler.FinishTask task let get_destination_files target = let all_modes = get_all_modes target in match target.Target.target_name with | Name.Lib libname -> List.map (fun (typ,opt) -> Libname.to_cmca typ opt libname) all_modes | Name.Exe _ | Name.Test _ | Name.Bench _ | Name.Example _ -> List.map (fun (ty,opt) -> Utils.to_exe_name opt ty (Target.get_target_dest_name target) ) all_modes let sanity_check build_dir target = let files = get_destination_files target in let allOK = List.for_all (fun f -> let test = Filesystem.exists (build_dir f) in if not test then verbose Debug "warning: missing file %s" (fp_to_string (build_dir f)); test ) files in if not allOK then verbose Report "warning: some target file appears to be missing"; () let check task_index task task_context dag = let (_,target) = Hashtbl.find task_context task in let buildDir = Dist.get_build_path (Dist.Target target.target_name) in let (nb_step,nb_step_len) = get_nb_step dag in verbose Report "[%*d of %d] Checking %s\n%!" nb_step_len task_index nb_step (fp_to_string buildDir); sanity_check buildDir target; Scheduler.FinishTask task (* compile will process the compilation DAG, * which will compile all C sources and OCaml modules. *) let compile (bstate: build_state) task_context dag = let taskdep = Taskdep.init dag in (* a compilation task has finished, terminate the process, * and process the result *) let schedule_finish (task, st) is_done = (match Process.terminate (task, st) with | Process.Success (_, warnings, _) -> (* TODO: store warnings for !isDone and print them if they are different when isDone *) if is_done then print_warnings warnings | Process.Failure er -> match task with | CompileC _ -> raise (CCompilationFailed er) | _ -> raise (CompilationFailed er) ); if is_done then Taskdep.mark_done taskdep task in let dispatch (task_index, task) = match task with | (CompileC m) -> compile_c task_index task m bstate task_context dag | (CompileInterface m) -> compile_module task_index task true m bstate task_context dag | (CompileModule m) -> compile_module task_index task false m bstate task_context dag | (CompileDirectory m) -> compile_directory task_index task m task_context dag | (LinkTarget _) -> link task_index task bstate task_context dag | (CheckTarget _) -> check task_index task task_context dag in let stat = Scheduler.schedule gconf.parallel_jobs taskdep dispatch schedule_finish in verbose Verbose "schedule finished: #processes=%d max_concurrency=%d\n" stat.Scheduler.nb_processes stat.Scheduler.max_runqueue; () let build_exe bstate exe = let target = Project.Executable.to_target exe in let modules = [Hier.of_filename exe.Project.Executable.main] in let task_context = Hashtbl.create 64 in let build_dir = Dist.create_build (Dist.Target target.target_name) in let cstate = prepare_target bstate build_dir target modules in List.iter (fun n -> Hashtbl.add task_context n (cstate,target)) (Dag.getNodes cstate.compilation_dag); compile bstate task_context cstate.compilation_dag let rec select_leaves children duplicate dag = let (good,bad) = List.partition (fun a -> not (List.mem a duplicate)) children in let new_ = ref [] in List.iter (fun a -> let parents = Dag.getParents dag a in List.iter (fun p -> new_ := p :: !new_) parents ) bad; if List.length bad > 0 then select_leaves (!new_ @ good) duplicate dag else good let build_dag bstate proj_file targets_dag = let dag = Dag.init () in let task_context = Hashtbl.create 64 in let taskdep = Taskdep.init targets_dag in let targets_deps = Hashtbl.create 64 in let prepare_state target modules = let build_dir = Dist.create_build (Dist.Target target.target_name) in let cstate = prepare_target bstate build_dir target modules in List.iter (fun n -> Hashtbl.add task_context n (cstate,target)) (Dag.getNodes cstate.compilation_dag); let duplicate = Dag.merge dag cstate.compilation_dag in (cstate.compilation_dag, duplicate) in while not (Taskdep.is_complete taskdep) do (match Taskdep.get_next taskdep with | None -> failwith "no free task in targets" | Some (_,ntask) -> verbose Verbose "preparing target %s\n%!" (Name.to_string ntask); let (cur_dag,dups) = (match ntask with | Name.Exe name -> let exe = Project.find_exe proj_file name in prepare_state (Project.Executable.to_target exe) [Hier.of_filename exe.Project.Executable.main] | Name.Lib name -> let lib = Project.find_lib proj_file name in prepare_state (Project.Library.to_target lib) lib.Project.Library.modules | Name.Bench name -> let bench = Project.find_bench proj_file name in prepare_state (Project.Bench.to_target bench) [Hier.of_filename bench.Project.Bench.main] | Name.Test name -> let test = Project.find_test proj_file name in prepare_state (Project.Test.to_target test) [Hier.of_filename test.Project.Test.main] | Name.Example name -> let example = Project.find_example proj_file name in prepare_state (Project.Example.to_target example) [Hier.of_filename example.Project.Example.main] ) in if (Hashtbl.mem targets_deps ntask) then begin let children = Dag.getLeaves cur_dag in let children = select_leaves children dups cur_dag in let roots = Hashtbl.find targets_deps ntask in List.iter (fun child -> List.iter (fun root -> Dag.addEdge child root dag ) roots ) children end; let roots = Dag.getRoots cur_dag in (* should be LinkTarget *) List.iter (fun p -> Hashtbl.add targets_deps p roots) (Dag.getParents targets_dag ntask); Taskdep.mark_done taskdep ntask ) done; compile bstate task_context dag obuild-obuild-v0.1.10/obuild/buildprogs.ml000066400000000000000000000160561327005302600205010ustar00rootroot00000000000000open Types open Ext open Ext.Filepath open Ext.Fugue open Process open Prepare open Gconf exception LinkingFailed of string exception InferFailed of string type c_linking_mode = LinkingStatic | LinkingShared type linking_mode = LinkingLibrary | LinkingPlugin | LinkingExecutable type annotation_mode = AnnotationNone | AnnotationBin | AnnotationText | AnnotationBoth type packopt = Hier.t option let annotToOpts = function | AnnotationNone -> [] | AnnotationBin -> ["-bin-annot"] | AnnotationText -> ["-annot"] | AnnotationBoth -> ["-bin-annot";"-annot"] let runOcamlCompile dirSpec useThread annotMode buildMode compileOpt packopt pp oflags modhier = let dstDir = dirSpec.dst_dir in let entry = Hier.get_file_entry modhier [dirSpec.src_dir] in let src_file = Hier.get_src_file dirSpec.src_dir entry in let compileOpt = if buildMode = Interface && compileOpt = WithProf then WithDebug else compileOpt in Filesystem.mkdirSafeRecursive dstDir 0o755; let (prog, srcFile, dstFile) = match buildMode with | Interface -> (Prog.getOcamlC () ,Hier.ml_to_ext src_file Filetype.FileMLI ,Hier.get_dest_file dstDir Filetype.FileCMI modhier ) | Compiled ct -> let ext = if ct = ByteCode then Filetype.FileCMO else Filetype.FileCMX in ((if ct = ByteCode then Prog.getOcamlC () else Prog.getOcamlOpt ()) ,src_file ,Hier.get_dest_file dstDir ext modhier ) in let args = [prog] @ (match useThread with | NoThread -> [] | WithThread -> ["-thread"]) @ (Utils.to_include_path_options dirSpec.include_dirs) @ (match compileOpt with | Normal -> [] | WithDebug -> ["-g"] | WithProf -> ["-p"]) @ annotToOpts annotMode @ oflags @ gconf.ocaml_extra_args @ Pp.to_params pp @ maybe [] (fun x -> if buildMode = Compiled Native then [ "-for-pack"; Hier.to_string x ] else []) packopt @ (if gconf.short_path then [ "-short-paths" ] else []) @ ["-o"; fp_to_string dstFile ] @ ["-c"; fp_to_string srcFile ] in Process.make args let runOcamlPack srcDir dstDir annotMode buildMode packOpt dest modules = let prog = if buildMode = ByteCode then Prog.getOcamlC () else Prog.getOcamlOpt () in let ext = if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let ext_f = function | Filetype.FileML -> ext | Filetype.FileMLI -> Filetype.FileCMI | _ -> (* It should not happen *) if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in Filesystem.mkdirSafeRecursive dstDir 0o755; let args = [prog] @ maybe [] (fun x -> if buildMode = Native then [ "-for-pack"; Hier.to_string x ] else []) packOpt @ annotToOpts annotMode @ [ "-pack"; "-o"; fp_to_string (Hier.get_dest_file dstDir ext dest); ] @ List.map (fun m -> fp_to_string (Hier.get_dest_file_ext dstDir m ext_f)) modules in Process.make args let runOcamlInfer srcDir includes pp modname = let entry = Hier.get_file_entry modname [srcDir] in let args = [Prog.getOcamlC (); "-i"] @ Pp.to_params pp @ (Utils.to_include_path_options includes) @ [fp_to_string (Hier.get_src_file srcDir entry)] in match run args with | Success (mli, _, _) -> mli | Process.Failure er -> raise (InferFailed er) let o_from_cfile file = file <.> "o" let runCCompile project dirSpec cflags file = let dstDir = dirSpec.dst_dir in Filesystem.mkdirSafeRecursive dstDir 0o755; let callCCompiler = string_words_noempty (Analyze.get_ocaml_config_key "bytecomp_c_compiler" project) in let srcFile = dirSpec.src_dir file in (* make a .c.o file to avoid collision *) let dstFile = dirSpec.dst_dir o_from_cfile file in let args = callCCompiler @ cflags @ (Utils.to_include_path_options dirSpec.include_dirs) @ ["-o"; fp_to_string dstFile] @ ["-c"; fp_to_string srcFile] in Process.make args let runAr dest deps = let args = [ Prog.getAR (); "rc"; fp_to_string dest ] @ List.map fp_to_string deps in Process.make args let runRanlib dest = Process.make [ Prog.getRanlib (); fp_to_string dest ] let runCLinking sharingMode depfiles dest = let args = if gconf.ocamlmklib then [ Prog.getOcamlMklib () ] @ (match sharingMode with | LinkingStatic -> ["-custom"] | LinkingShared -> []) @ ["-o"; fp_to_string dest ] @ List.map fp_to_string depfiles else (* Not working if system != linux *) [ Prog.getCC () ] @ (match sharingMode with | LinkingStatic -> [] | LinkingShared -> ["-shared"]) (* TODO: fix this for all system != linux *) @ ["-o"; fp_to_string dest ] @ List.map fp_to_string depfiles in Process.make args let runOcamlLinking includeDirs buildMode linkingMode compileType useThread systhread cclibs libs modules dest = (* create a soft link to a freshly compiled exe, unless a file with the same name already exist *) let link_maybe linking_mode dest = let file_or_link_exists fn = try let _ = Unix.lstat fn in true with _ -> false in (match linking_mode with | LinkingPlugin | LinkingLibrary -> () | LinkingExecutable -> if not (Gconf.get_target_option "executable-as-obj") then let real = fp_to_string dest in let basename = Filename.basename real in if not (file_or_link_exists basename) then Unix.symlink real basename) in let prog = match buildMode with | Native -> Prog.getOcamlOpt () | ByteCode -> Prog.getOcamlC () in let ext = if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let args = [ prog ] @ (match useThread with | NoThreads -> [] | PosixThread -> ["-thread"] | VMThread -> ["-vmthread"] | DefaultThread -> (if systhread = "true" then ["-thread"] else ["-vmthread"])) @ (match linkingMode with | LinkingPlugin -> ["-shared"] | LinkingLibrary -> ["-a"] | LinkingExecutable -> if (Gconf.get_target_option "executable-as-obj") then ["-output-obj"] else []) @ ["-o"; fp_to_string dest] @ (match compileType with | Normal -> [] | WithDebug -> ["-g"] | WithProf -> ["-p"]) @ (Utils.to_include_path_options includeDirs) @ (List.map fp_to_string libs) @ (List.concat (List.map (fun x -> [ (match buildMode with | Native -> "-cclib" | ByteCode -> if x.[1] = 'L' then "-cclib" else "-dllib") (* Ugly hack but do the job for now *) ; x ]) cclibs)) @ (List.map (fun m -> fp_to_string (Hier.get_dest_file currentDir ext m)) modules) in let res = Process.make args in let () = link_maybe linkingMode dest in res obuild-obuild-v0.1.10/obuild/configure.ml000066400000000000000000000170361327005302600203070ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext open Helper open Printf open Gconf exception ConfigChanged of string exception ToolNotFound of filename exception ConfigurationMissingKey of string exception ConfigurationTypeMismatch of string * string * string exception ConfigureScriptFailed of string type flag_action = SetFlag of string | ClearFlag of string let getDigestKV () = let digest = Project.digest () in [ ("obuild-digest", digest) ] let generateMlFile project file flags = Utils.generateFile file (fun add -> add "(* autogenerated file by obuild. do not modify *)\n"; add (sprintf "let project_version = \"%s\"\n" project.Analyze.project_file.Project.version); (* TODO escape name properly *) List.iter (fun (name, v) -> add (sprintf "let project_flag_%s = %b\n" name v)) flags; ) let generateCFile project file flags = Utils.generateFile file (fun add -> add "/* autogenerated file by obuild. do not modify */\n"; add (sprintf "#define PROJECT_VERSION \"%s\"\n" project.Analyze.project_file.Project.version); (* TODO escape name properly *) List.iter (fun (name, v) -> add (sprintf "#define PROJECT_FLAG_%s %d\n" (String.uppercase name) (if v then 1 else 0)) ) flags; ) let makeSetup digestKV project flags = hashtbl_fromList ( digestKV @ hashtbl_toList project.Analyze.project_ocamlcfg @ List.map (fun (opt,v) -> (opt, string_of_bool v)) (Gconf.get_target_options ()) @ List.map (fun (flagname,flagval) -> ("flag-" ^ flagname, string_of_bool flagval)) flags ) let sanityCheck () = let (_: string) = Prog.getOcamlOpt () in let (_: string) = Prog.getOcamlC () in let (_: string) = Prog.getOcamlDep () in () let comparekvs reason setup l = List.iter (fun (k,v) -> try let v' = Hashtbl.find setup k in if v' <> v then raise (ConfigChanged reason) with Not_found -> raise (ConfigChanged reason) ) l let comparekvs_hashtbl reason setup l = Hashtbl.iter (fun k v -> try let v' = Hashtbl.find setup k in if v' <> v then raise (ConfigChanged reason) with Not_found -> raise (ConfigChanged reason) ) l let execute_configure_script proj_file = match proj_file.Project.configure_script with | None -> () | Some script -> let args = [ (Prog.getOcaml ()); (fp_to_string script) ] in (match Process.run args with | Process.Success (_, warnings,_) -> print_warnings warnings | Process.Failure er -> raise (ConfigureScriptFailed er)) let create_dist project flags = verbose Verbose "configuration changed, deleting dist\n%!"; Filesystem.removeDirContent (Dist.build_path); Dist.remove_dead_links (); verbose Verbose "auto-generating configuration files\n%!"; let autogenDir = Dist.create_build Dist.Autogen in generateMlFile project (autogenDir fn "path_generated.ml") flags; generateCFile project (autogenDir fn "obuild_macros.h") flags let get_assoc name assoc = try let v = List.assoc name assoc in Some v with Not_found -> None let get_flags_value proj_file setup_flags user_flags = List.map (fun flag -> let name = flag.Project.Flag.name in let def = flag.Project.Flag.default in let override = ref (get_assoc name setup_flags) in List.iter (fun tw -> match tw with | ClearFlag s -> if s = name then override := Some false | SetFlag s -> if s = name then override := Some true ) user_flags; match (!override, def) with | (None, None) -> (name, false) | (None, Some v) -> (name, v) | (Some v, _) -> (name, v) ) proj_file.Project.flags let check_extra_tools proj_file = let syspath = Utils.get_system_paths () in List.iter (fun tool -> try let _ = Utils.find_in_paths syspath tool in () with Utils.FileNotFoundInPaths _ -> raise (ToolNotFound tool) ) proj_file.Project.extra_tools let get_flags hash = Hashtbl.fold (fun k v acc -> if string_startswith "flag-" k then (string_drop 5 k, bool_of_string v) :: acc else acc) hash [] let bool_of_opt hashtable k = let get_opt k = try Hashtbl.find hashtable k with Not_found -> raise (ConfigurationMissingKey k) in let v = get_opt k in try bool_of_string v with Failure _ -> raise (ConfigurationTypeMismatch (k,"bool",v)) let set_opts hashtable = (* load the environment *) let opts = Gconf.get_target_options_keys () in List.iter (fun k -> Gconf.set_target_options k (bool_of_opt hashtable k)) opts let check_ocaml () = let ocamlCfg = Prog.getOcamlConfig () in let ocaml_ver = Hashtbl.find ocamlCfg "version" in let ver = string_split '.' ocaml_ver in (match ver with | major::minor::_-> ( if int_of_string major < 4 then gconf.bin_annot <- false; if int_of_string major > 4 && int_of_string minor > 1 then gconf.short_path <- true ) | _ -> gconf.bin_annot <- false ); ocamlCfg let run proj_file user_flags user_opts = Dist.create_maybe (); let _ = check_ocaml () in let digestKV = getDigestKV () in execute_configure_script proj_file; let configure = try Some (Dist.read_configure ()) with _ -> None in let configure_flags = match configure with | None -> [] | Some h -> (* set opts and return the flags *) Hashtbl.iter (fun k _ -> if not (string_startswith "flag-" k) then Gconf.set_target_options k (bool_of_opt h k) ) h; get_flags h in let flags = get_flags_value proj_file configure_flags user_flags in verbose Debug " configure flag: [%s]\n" (Utils.showList "," (fun (n,v) -> n^"="^string_of_bool v) flags); check_extra_tools proj_file; let project = Analyze.prepare proj_file flags in (* let's set the user opts before saving the setup file *) List.iter (fun (o,v) -> Gconf.set_target_options o v) user_opts; let currentSetup = makeSetup digestKV project flags in let actualSetup = try Some (Dist.read_setup ()) with _ -> None in let projectSystemChanged = match actualSetup with | None -> true | Some stp -> (* TODO harcoded for now till we do all the checks. *) try comparekvs "setup" stp (hashtbl_toList currentSetup); (* FORCED should be false *) true with _ -> true in if projectSystemChanged then ( create_dist project flags; (* write setup file *) verbose Verbose "Writing new setup\n%!"; Dist.write_setup currentSetup ) let check proj_file reconf setup = let ocamlCfg = check_ocaml () in let digestKV = getDigestKV () in (* check if the environment changed. *) comparekvs_hashtbl "ocaml config" setup ocamlCfg; (* if the digest of .obuild changed, let's reconfigure *) let reconfigure = try comparekvs "digest" setup digestKV; false with e -> if reconf then true else raise e in (* user_flags are also restored from setup file *) let setup_flags = get_flags setup in let flags = get_flags_value proj_file setup_flags [] in (* .obuild changed, maybe we should compare a little bit deeper to not retriggerd reconf too often ... *) if reconfigure then begin (* let's call configure-script if available, however we don't care about the content of dist/configure *) execute_configure_script proj_file; verbose Debug " configure flag: [%s]\n" (Utils.showList "," (fun (n,v) -> n^"="^string_of_bool v) flags); check_extra_tools proj_file; let project = Analyze.prepare proj_file flags in create_dist project flags; (* write setup file *) verbose Verbose "Writing new setup\n%!"; let current_setup = makeSetup digestKV project flags in Dist.write_setup current_setup end; flags obuild-obuild-v0.1.10/obuild/dag.ml000066400000000000000000000166101327005302600170560ustar00rootroot00000000000000(* simple bi-directional DAG implementation using shallow link*) open Printf open Ext.Compat (* represent a node that point shallowly to children and parents *) type 'a dagnode = { mutable parents : 'a list ; mutable children : 'a list } (* TODO add a 'a <-> int table, so that indexing can be done on int instead and that lists can be replaced by set *) type 'a t = { nodes : ('a, 'a dagnode) Hashtbl.t } let init () = { nodes = Hashtbl.create 16 } let length dag = Hashtbl.length dag.nodes (* Add an directed edge from a to b. * * 'a' is the parent of 'b' * 'b' is the child of 'a' *) let addEdge a b dag = let maNode = try Some (Hashtbl.find dag.nodes a) with Not_found -> None in let mbNode = try Some (Hashtbl.find dag.nodes b) with Not_found -> None in (match (maNode, mbNode) with | None, None -> Hashtbl.add dag.nodes a { parents = []; children = [b] }; Hashtbl.add dag.nodes b { parents = [a]; children = [] } | Some aNode, None -> if not (List.mem b aNode.children) then aNode.children <- b :: aNode.children; Hashtbl.add dag.nodes b { parents = [a]; children = [] } | None, Some bNode -> if not (List.mem a bNode.children) then bNode.parents <- a :: bNode.parents; Hashtbl.add dag.nodes a { parents = []; children = [b] } | Some aNode, Some bNode -> if not (List.mem b aNode.children) then aNode.children <- b :: aNode.children; if not (List.mem a bNode.children) then bNode.parents <- a :: bNode.parents ); () exception DagNode_Not_found exception DagNode_Already_Exists let addNode a dag = try let _ = Hashtbl.find dag.nodes a in () with Not_found -> Hashtbl.add dag.nodes a { parents = []; children = [] } let addNode_exclusive a dag = try let _ = Hashtbl.find dag.nodes a in raise DagNode_Already_Exists with Not_found -> Hashtbl.add dag.nodes a { parents = []; children = [] } (* has edge from a to b *) let hasEdge a b dag = let maNode = try Some (Hashtbl.find dag.nodes a) with Not_found -> None in let mbNode = try Some (Hashtbl.find dag.nodes b) with Not_found -> None in match (maNode, mbNode) with | Some aNode, Some bNode -> List.mem b aNode.children && List.mem a bNode.parents | _ -> false let delEdge a b dag = let maNode = try Some (Hashtbl.find dag.nodes a) with Not_found -> None in let mbNode = try Some (Hashtbl.find dag.nodes b) with Not_found -> None in (match (maNode, mbNode) with | Some aNode, Some bNode -> aNode.children <- List.filter (fun x -> x <> b) aNode.children; bNode.parents <- List.filter (fun x -> x <> a) bNode.parents | _ -> () ) let addEdges l dag = List.iter (fun (n1, n2) -> addEdge n1 n2 dag) l (* add edges connected to each other in a list * n1 -> n2 -> n3 -> ... -> nn *) let addEdgesConnected l dag = let rec loop parent nodes = match nodes with | [] -> () | n::ns -> addEdge parent n dag; loop n ns in match l with | [] -> () | x::[] -> addNode x dag | x::l -> loop x l (* add children edges with p the parent * p -> l[1], p -> l[2], ..., p -> l[n] *) let addChildrenEdges p l dag = List.iter (fun x -> addEdge p x dag) l let existsNode a dag = Hashtbl.mem dag.nodes a let getLeaves dag = Hashtbl.fold (fun k v acc -> if v.children = [] then k::acc else acc) dag.nodes [] let getRoots dag = Hashtbl.fold (fun k v acc -> if v.parents = [] then k::acc else acc) dag.nodes [] let getNode dag a = try Hashtbl.find dag.nodes a with Not_found -> raise DagNode_Not_found let getNodes dag = Hashtbl.fold (fun k _ acc -> k :: acc) dag.nodes [] let getChildren dag a = (getNode dag a).children let getParents dag a = (getNode dag a).parents let rec getChildren_full dag a = let children = getChildren dag a in children @ List.concat (List.map (getChildren_full dag) children) let isChildren dag a b = List.mem b (getChildren dag a) let rec isChildren_full dag a b = let children = getChildren dag a in (* either it's present here, or in one of the kiddy *) List.mem b children || List.fold_left (fun acc child -> acc || isChildren_full dag child b ) false children let subset dag roots = let subdag = init () in let rec loop node = addNode node subdag; let children = getChildren dag node in List.iter (fun child -> addEdge node child subdag; loop child) children in List.iter (fun root -> loop root) roots; subdag let copy dag = let nodes = Hashtbl.fold (fun k _ acc -> k :: acc) dag.nodes [] in let dag2 = init () in let copy_node node = addNode node dag2; let children = getChildren dag node in addChildrenEdges node children dag2 in List.iter (fun node -> copy_node node) nodes; dag2 let merge dest src = let nodes = Hashtbl.fold (fun k _ acc -> k :: acc) src.nodes [] in let dups = ref [] in List.iter (fun node -> if existsNode node dest then dups := node :: !dups) nodes; let copy_node node = addNode node dest; let children = getChildren src node in addChildrenEdges node children dest in List.iter (fun node -> copy_node node) nodes; !dups (* o(v^3) use with care *) let transitive_reduction dag = let reducedDag = copy dag in (* this is sub optimal, as we re-lookup nodes everytimes in hasEdge AND delEdge. * would go away automatically when having the lookup dict with sets. *) let nodes = Hashtbl.fold (fun k _ acc -> k :: acc) dag.nodes [] in List.iter (fun x -> List.iter (fun y -> List.iter (fun z -> if hasEdge x y dag && hasEdge y z dag then delEdge x z reducedDag else () ) nodes ) nodes ) nodes; reducedDag (* this is for debugging the DAG. * dump the dag links and node in a textual format *) let dump a_to_string dag = let all = getNodes dag in List.iter (fun n -> printf "%s:\n" (a_to_string n); printf " | parents = %s\n" (String.concat ", " (List.map a_to_string (getParents dag n))); printf " | children = %s\n" (String.concat ", " (List.map a_to_string (getChildren dag n))) ) all (* it's useful to be able to visualize the DAG with the excellent dot *) let toDot a_to_string name fromLeaf dag = let buf = Buffer.create 1024 in let nodes = getNodes dag in let dotIndex = Hashtbl.create (List.length nodes) in let append = Buffer.add_string buf in let sanitizeName = bytes_of_string name in for i = 0 to String.length name - 1 do if (bytes_get sanitizeName i) = '-' then bytes_set sanitizeName i '_' done; append ("digraph " ^ (bytes_to_string sanitizeName) ^ " {\n"); let list_iteri f list = let rec loop i l = match l with | [] -> () | x::xs -> f i x; loop (i+1) xs in loop 1 list in list_iteri (fun i n -> Hashtbl.add dotIndex n i; append (sprintf " %d [label = \"%s\"];\n" i (a_to_string n)); ) nodes; List.iter (fun n -> let i = Hashtbl.find dotIndex n in List.iter (fun child -> let ci = Hashtbl.find dotIndex child in append (sprintf " %d -> %d;\n" i ci) ) ((if fromLeaf then getParents else getChildren) dag n) ) nodes; append "}\n"; Buffer.contents buf obuild-obuild-v0.1.10/obuild/dagutils.ml000066400000000000000000000016771327005302600201460ustar00rootroot00000000000000let iter f dag = let tdep = Taskdep.init dag in while not (Taskdep.is_complete tdep) do match Taskdep.get_next tdep with | None -> failwith "taskdep dag next didn't work" | Some (_,task) -> f task; Taskdep.mark_done tdep task done let iteri f dag = let tdep = Taskdep.init dag in while not (Taskdep.is_complete tdep) do match Taskdep.get_next tdep with | None -> failwith "taskdep dag next didn't work" | Some (idx,task) -> f idx task; Taskdep.mark_done tdep task done let linearize dag = let tdep = Taskdep.init dag in let rec loop () = if Taskdep.is_complete tdep then [] else ( match Taskdep.get_next tdep with | None -> failwith "taskdep dag next didn't work" | Some (_,task) -> Taskdep.mark_done tdep task; task :: loop () ) in loop () obuild-obuild-v0.1.10/obuild/dependencies.ml000066400000000000000000000051741327005302600207540ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext.Compat exception BuildDepAnalyzeFailed of string exception BuildCDepAnalyzeFailed of string exception DependencyMissing of string exception DependenciesMissing of string list exception DependencyFailedParsing of string type dependency = Libname.t * (Expr.t option) type cdependency = string * (Expr.t option) type dep_opt = { dep_includes: filepath list ; dep_pp : Pp.t } let parse_output_KsemiVs onNonKV mapFstTy mapSndTys out = List.map (fun (k, mv) -> match mv with | None -> onNonKV k | Some v -> (mapFstTy k, List.map mapSndTys (string_words_noempty v)) ) (List.map Utils.toKV (string_lines_noempty out)) (* return the (modules list) dependency for a specific file *) let runOcamldep dopt srcFile = let wrap_module_safe f = try Modname.wrap f with _ -> raise (BuildDepAnalyzeFailed ("ocamldep returned a bad module name " ^ f)) in let fileType = Filetype.of_filepath srcFile in let baseFile = fp_to_string srcFile in let files = if fileType = Filetype.FileML then [baseFile; baseFile ^ "i"] else [baseFile] in let args = [Prog.getOcamlDep ()] @ (Utils.to_include_path_options dopt.dep_includes) @ (Pp.to_params dopt.dep_pp) @ ["-modules"] @ files in match Process.run args with | Process.Failure er -> raise (BuildDepAnalyzeFailed er) | Process.Success (out,_,_) -> List.map snd (parse_output_KsemiVs (fun _ -> raise (BuildDepAnalyzeFailed ("assumption failed: " ^ out))) fp wrap_module_safe out ) (* TODO * gcc escape spaces in filename with a \, tweak strings_words_noempty * to take that in consideration. *) let joinLines s = let s = bytes_of_string s in let s_end = bytes_length s in let rec replace start = try let index = bytes_index_from s start '\\' in if index < s_end - 1 then if (bytes_get s (index + 1)) = '\n' then begin bytes_set s index ' '; bytes_set s (index + 1) ' '; replace (index + 2) end else replace (index + 1) else s with Not_found -> s in bytes_to_string (replace 0) let runCCdep srcDir files : (filename * filepath list) list = let args = [Prog.getCC (); "-MM"] @ List.map (fun fn -> fp_to_string (srcDir fn)) files in match Process.run args with | Process.Failure err -> raise (BuildCDepAnalyzeFailed err) | Process.Success (out,_,_) -> parse_output_KsemiVs (fun _ -> raise (BuildCDepAnalyzeFailed "missing semicolon in gcc dependency output")) fn fp (joinLines out) obuild-obuild-v0.1.10/obuild/dist.ml000066400000000000000000000044331327005302600172660ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext type t = Autogen | Dot | Target of Target.Name.t let to_string = function | Autogen -> "autogen" | Dot -> "dot" | Target n -> "target(" ^ Target.Name.to_string n ^ ")" let to_filename = function | Target tn -> Target.Name.to_dirname tn | Dot -> fn ("dot") | Autogen -> fn ("autogen") exception NotADirectory exception MissingDestinationDirectory of t exception DoesntExist exception FileDoesntExist of string let path = ref (fp "dist") let set_path p = path := p let get_path () = !path let setup_path = get_path () fn "setup" let configure_path = get_path () fn "configure" let build_path = get_path () fn "build" let check_exn f = if Filesystem.exists (get_path ()) then (if Sys.is_directory $ fp_to_string (get_path ()) then () else raise NotADirectory) else f () let exist () = check_exn (fun () -> raise DoesntExist) let create_maybe () = check_exn (fun () -> let _ = Filesystem.mkdirSafe (get_path ()) 0o755 in ()) let get_build () = get_path () fn "build" let get_build_path buildtype = get_build () (to_filename buildtype) let get_build_exn buildtype = let dist = get_build_path buildtype in if not (Filesystem.is_dir dist) then raise (MissingDestinationDirectory buildtype) else dist let create_build buildtype = let _ = Filesystem.mkdirSafe (get_build ()) 0o755 in let dest = get_build_path buildtype in let _ = Filesystem.mkdirSafe dest 0o755 in dest let read_dist_file path = try let content = Filesystem.readFile path in hashtbl_fromList (List.map (fun l -> second (default "") $ Utils.toKV l) $ string_split '\n' content) with _ -> raise (FileDoesntExist (fp_to_string path)) let read_setup () = read_dist_file setup_path let read_configure () = read_dist_file configure_path let write_setup setup = let kv (k,v) = k ^ ": " ^ v in Filesystem.writeFile setup_path (String.concat "\n" $ List.map kv (hashtbl_toList setup)) let remove_dead_links () = let files = Sys.readdir "." in let build_path = fp_to_string (get_build ()) in Array.iter (fun fn -> try let l = Unix.readlink fn in if (string_startswith build_path l) then Sys.remove fn with _ -> ()) files obuild-obuild-v0.1.10/obuild/exception.ml000066400000000000000000000122311327005302600203140ustar00rootroot00000000000000open Printf open Helper open Ext.Filepath (* TODO normalize exit code *) let show exn = let error fmt = eprintf ("%serror%s: " ^^ fmt) (color_white ()) (color_white ()) in match exn with | Arg.Bad err -> eprintf "%s\n" err; exit 2 | Arg.Help h -> eprintf "%s\n" h; exit 0 (* project file related *) | Project.NoConfFile -> error "couldn't find obuild file\n"; exit 3 | Project.MultipleConfFiles -> error "multiples obuild files found\n"; exit 3 | Project.FileDoesntExist (t,f) -> error "project is referencing in %s, a file %s that cannot be found\n" (Target.get_target_name t) (fn_to_string f); exit 3 | Project.ModuleDoesntExist (t,m) -> error "project is referencing in '%s', a module %s that cannot be found\n" (Target.get_target_name t) (Hier.to_string m); exit 3 | Project.ModuleListEmpty l -> error "library %s doesn't have any modules defined.\n" (Libname.to_string l); exit 3 | Project.InvalidConfFile c -> error "configuration file appears invalid: %s\n" c; exit 3 | Project.BlockSectionAsValue s -> error "trying to define a section %s using parameter syntax:\n" s; eprintf " spurious colon between section definition and section name\n"; exit 3 | Project.BadOcamlVersion (ver,c) -> error "wrong ocaml version: actual %s expected %s\n" ver (Expr.to_string c); exit 3 | Expr.CannotParseConstraints (builddep, s) -> error "cannot parse constraints for build dependency '%s': %s\n" builddep s; exit 3 (* dist directory related *) | Dist.NotADirectory -> error "dist is not a directory\n"; exit 4 | Dist.DoesntExist -> error "run 'obuild configure' first\n"; exit 4 | Dist.MissingDestinationDirectory dir -> error "missing destination directory: %s\n" (Dist.to_string dir); exit 4 (* types stuff *) | Target.TargetNameNoType s -> error "Unknown target '%s' with no prefix:\n" s; error " targets need to start by one of lib-,exe-,bench-,test-,example-\n"; exit 4 | Target.TargetUnknownType (p,s) -> error "unknown type prefix '%s' in '%s':\n" p s; error " targets need to start by one of lib-,exe-,bench-,test-,example-\n"; exit 4 | Target.TargetNotRecognized s -> error "Unknown target specified '%s'\n" s; exit 4 (* reconfigure *) | Configure.ConfigChanged r -> (match r with | "digest" -> error "project file changed. run 'obuild configure' again\n"; exit 4 | _ -> error "config changed (reason=%s). run 'obuild configure' again\n" r; exit 4 ) | Configure.ConfigurationMissingKey k -> error "cannot find key %s in setup. run 'obuild configure' again\n" k; exit 4 | Configure.ConfigurationTypeMismatch (k,t,v) -> error "%s type mismatch (got '%s') in setup key %s. run 'obuild configure' again\n" t v k; exit 4 | Meta.MetaParseError (fp,err) -> error "unexpected parse error '%s' in meta file %s\n" err (fp_to_string fp); exit 4 | Meta.ArchiveNotFound (path, dep, preds) -> error "archive %s not found in %s (%s)\n" (Utils.showList "," Meta.Predicate.to_string preds) (Libname.to_string dep) (fp_to_string path); exit 4 | Analyze.SublibraryDoesntExists dep -> error "dependency %s not found\n" (Libname.to_string dep); exit 4 (* build related failure *) | Prepare.Module.DependsItself m -> error "cyclic dependency module detected in module %s\n" (Hier.to_string m); exit 5 | Prepare.Module.NotFound (paths,m) -> error "module not found %s - search paths:\n" (Hier.to_string m); List.iter (fun path -> eprintf "\t%s\n" (fp_to_string path)) paths; exit 5 | Prepare.Module.DependenciesProblem l -> error "cyclic dependency detected. cannot infer dependencies between modules:\n"; eprintf "\t%s\n" (Utils.showList ", " Hier.to_string l); exit 5 | Build.CompilationFailed e -> eprintf "\n%s\n%!" e; exit 6 | Build.CCompilationFailed e -> eprintf "\n%s\n%!" e; exit 6 | Buildprogs.LinkingFailed e -> eprintf "\n%s\n%!" e; exit 7 | Dependencies.BuildDepAnalyzeFailed e -> eprintf "\n%s\n%!" e; exit 8 | Dependencies.DependenciesMissing missing -> begin match List.length missing with | 0 -> assert false | 1 -> error "missing dependency '%s'\n" (List.hd missing); exit 9 | _ -> eprintf "missing dependencies:\n%s\n" (Utils.showList "\n" (fun x -> x) missing); exit 9 end (* others exception *) | Unix.Unix_error (err, fname, params) -> error "unexpected unix error: \"%s\" during %s(%s)\n" (Unix.error_message err) fname params; exit 20 | Ext.Filepath.InvalidFilename f -> error "the filename \"%s\" is not valid, it contains a directory separator\n" f; exit 30 | Utils.FileNotFoundInPaths (ds,f) -> error "File %s not found in directories %s\n" (fn_to_string f) (Utils.showList "; " fp_to_string ds); exit 40 | Exit -> () | e -> eprintf "uncaught exception\n"; raise e obuild-obuild-v0.1.10/obuild/expr.ml000066400000000000000000000203011327005302600172710ustar00rootroot00000000000000open Ext.Fugue exception UnknownSymbol of (string * string) exception UnknownExpression of string exception ExpressionEmpty exception UnbalancedParenthesis exception MalformedExpression exception InvalidDependencyName of string exception CannotParseConstraints of (string * string) type version = string module Token = struct type t = | VER of string (* version *) | ID of string (* ident *) | LPAREN | RPAREN | AND | OR | NOT | EQ | NE | GT | LT | GE | LE let to_string = function | VER v -> v | ID s -> s | LPAREN -> "(" | RPAREN -> ")" | AND -> "&" | OR -> "|" | NOT -> "!" | EQ -> "==" | NE -> "!=" | GT -> ">" | LT -> "<" | GE -> ">=" | LE -> "<=" let of_string symbol s = match symbol with | "&&" | "&" -> AND | "||" | "|" -> OR | ">" -> GT | "<" -> LT | ">=" -> GE | "<=" -> LE | "==" | "=" -> EQ | "!=" | "/=" -> NE | "!" -> NOT | _ -> raise (UnknownSymbol (symbol,s)) let process_one_char c next = match (c,next) with | '(', _ -> LPAREN | ')', _ -> RPAREN | '!', Some '=' -> raise Not_found (* should be parsed as a string != *) | '!', _ -> NOT | _ -> raise Not_found (* valid char per types *) let is_symbol_char c = try let _ = String.index "&/|!+=><()" c in true with _ -> false let is_ident_char c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c == '_' || c == '.' || c == '-' let is_version_char c = (c >= '0' && c <= '9') || c = '.' || c = '*' let lexer s = let len = String.length s in let while_pred pred o = let i = ref o in while !i < len && pred s.[!i] do i := !i + 1 done; (String.sub s o (!i-o), !i) in (* Per type lexer *) let eat_symbol o = let (tok,no) = let next = if o+1 < len then Some (s.[o+1]) else None in try let tok = process_one_char s.[o] next in (tok,o+1) with Not_found -> let (p, no) = while_pred is_symbol_char o in let tok = of_string p s in (tok,no) in (tok,no) in let eat_version o = while_pred is_version_char o in let eat_ident o = while_pred is_ident_char o in (* main lexing loop *) let rec loop o = if o >= len then [] else begin (* TODO skip chunk of space in one go *) if s.[o] == ' ' || s.[o] == '\t' then ( loop (o+1) ) else if is_symbol_char s.[o] then ( let (sym, no) = eat_symbol o in sym :: loop no ) else if (s.[o] >= 'a' && s.[o] <= 'z') || (s.[o] >= 'A' && s.[o] <= 'Z') then ( let (id, no) = eat_ident o in ID id :: loop no ) else if is_version_char s.[o] then ( let (ver, no) = eat_version o in VER ver :: loop no ) else failwith (Printf.sprintf "unknown character in expression '%c'" s.[o]) end in loop 0 end type t = | And of t * t | Or of t * t | Not of t | Paren of t | Eq of version | Le of version | Lt of version | Ge of version | Gt of version | Ne of version let compare_version v1 v2 = let skip i p s e = let rec loop i = if i = e then i else if (p s.[i]) then loop (i + 1) else i in loop i in let split_version v = let (p1,rest) = match (string_split ':' v ~limit:2) with [ _ ] -> ("", v) | [ p1; rest] -> (p1, rest) in let (p1, p2, p3) = match (string_split '-' rest ~limit:2) with [ _ ] -> (p1, rest, "") | [ p2 ; p3 ] -> (p1, p2, p3) in (p1, p2, p3) in let compare_part p1 p2 = let l1 = String.length p1 in let l2 = String.length p2 in let is_digit = function | '0'..'9' -> true | _ -> false in let rec loop i1 i2 = let compare_numbers i1 i2 = let rec loop_numbers n1 n2 last = if n2 = last then loop n1 n2 else let comp = Char.compare p1.[n1] p2.[n2] in if comp = 0 then loop_numbers (n1 + 1) (n2 + 1) last else comp in let end1 = skip i1 is_digit p1 l1 in let end2 = skip i2 is_digit p2 l2 in let comp = compare (end1 - i1) (end2 - i2) in if comp = 0 then loop_numbers i1 i2 end1 else comp in match (i1 = l1, i2 = l2) with | true,true -> 0 | true,false -> let end2 = skip i2 (fun c -> c = '0') p2 l2 in if end2 = l2 then 0 else -1 | false,true -> let end1 = skip i1 (fun c -> c = '0') p1 l1 in if end1 = l1 then 0 else 1 | false,false -> match (is_digit p1.[i1], is_digit p2.[i2]) with | true,true -> compare_numbers (skip i1 (fun c -> c = '0') p1 l1) (skip i2 (fun c -> c = '0') p2 l2) | true,false -> -1 | false,true -> 1 | false,false -> let comp = Char.compare p1.[i1] p2.[i2] in if comp = 0 then loop (i1 + 1) (i2 + 1) else comp in loop 0 0 in if v1 = v2 then 0 else let (v1_1, v1_2, v1_3) = split_version v1 in let (v2_1, v2_2, v2_3) = split_version v2 in let c1 = compare_part v1_1 v2_1 in if c1 <> 0 then c1 else let c2 = compare_part v1_2 v2_2 in if c2 <> 0 then c2 else compare_part v1_3 v2_3 let rec eval version constr = match constr with | And (e1,e2) -> (eval version e1) && (eval version e2) | Or (e1,e2) -> (eval version e1) || (eval version e2) | Not e -> not (eval version e) | Paren e -> eval version e | Eq v -> compare_version version v = 0 | Le v -> compare_version version v <= 0 | Lt v -> compare_version version v < 0 | Ge v -> compare_version version v >= 0 | Gt v -> compare_version version v > 0 | Ne v -> compare_version version v <> 0 let rec to_string = function | And (e1,e2) -> (to_string e1) ^ " && " ^ (to_string e2) | Or (e1,e2) -> (to_string e1) ^ " || " ^ (to_string e2) | Not e -> "! " ^ (to_string e) | Paren e -> "(" ^ (to_string e) ^ ")" | Eq v -> "=" ^ v | Le v -> "<=" ^ v | Lt v -> "<" ^ v | Ge v -> ">=" ^ v | Gt v -> ">" ^ v | Ne v -> "!=" ^ v let showList sep f l = String.concat sep (List.map f l) let parse_expr l = let rec parse_sub_expr l = match l with | [] -> raise MalformedExpression | Token.NOT :: r -> let (e, r) = parse_sub_expr r in ((Not e), r) | Token.LPAREN :: r -> let (e, r) = parse_sub_expr r in let rec loop e r = (match r with | Token.RPAREN :: r -> (Paren e, r) | Token.OR :: _ | Token.AND :: _ -> let (e, r) = parse_bin_expr e r in loop e r | _ -> raise UnbalancedParenthesis; ) in loop e r | Token.GT :: Token.VER v :: r -> (Gt v, r) | Token.GE :: Token.VER v :: r -> (Ge v, r) | Token.EQ :: Token.VER v :: r -> (Eq v, r) | Token.LT :: Token.VER v :: r -> (Lt v, r) | Token.LE :: Token.VER v :: r -> (Le v, r) | Token.NE :: Token.VER v :: r -> (Ne v, r) | z -> raise (UnknownExpression (showList "," Token.to_string z)) and parse_bin_expr expr l = match l with | Token.OR :: r -> let (e, r) = parse_sub_expr r in ((Or (expr,e)), r) | Token.AND :: r -> let (e, r) = parse_sub_expr r in ((And (expr,e)), r) | _ -> raise MalformedExpression in let (e, r) = parse_sub_expr l in let rec loop e r = if(List.length r) = 0 then e else let (e,r) = parse_bin_expr e r in loop e r in loop e r let parse_constraints name cs = try match cs with | [] -> None | expr -> let e = parse_expr expr in Some e with e -> let err = match e with | UnknownExpression z -> "unknown constraints expression \"" ^ z ^ "\"" | UnbalancedParenthesis -> "unbalanced parenthesis" | MalformedExpression -> "malformed expression" | _ -> Printexc.to_string e in raise (CannotParseConstraints (name,err)) let parse name s = match Token.lexer s with | [] -> raise ExpressionEmpty | constraints -> parse_constraints name constraints let parse_builddep s = match Token.lexer s with | [] -> raise ExpressionEmpty | Token.ID name :: constraints -> (name, (parse_constraints name constraints)) | x :: _ -> raise (InvalidDependencyName (Token.to_string x)) obuild-obuild-v0.1.10/obuild/filetype.ml000066400000000000000000000042501327005302600201410ustar00rootroot00000000000000open Ext.Filepath type t = FileML | FileMLI | FileH | FileC | FileCMX | FileCMO | FileCMI | FileCMA | FileCMXA | FileCMXS | FileCMT | FileCMTI | FileO | FileA | FileSO | FileEXE | FileOther of string let of_string s = match s with | "ml" -> FileML | "mli" -> FileMLI | "h" -> FileH | "c" -> FileC | "cmx" -> FileCMX | "cmo" -> FileCMO | "cmi" -> FileCMI | "cma" -> FileCMA | "cmxa" -> FileCMXA | "cmxs" -> FileCMXS | "cmt" -> FileCMT | "cmti" -> FileCMTI | "o" -> FileO | "a" -> FileA | "so" -> FileSO | "exe" -> FileEXE | _ -> FileOther s let to_string fty = match fty with | FileML -> "ml" | FileMLI -> "mli" | FileH -> "h" | FileC -> "c" | FileCMX -> "cmx" | FileCMO -> "cmo" | FileCMI -> "cmi" | FileCMA -> "cma" | FileCMXA -> "cmxa" | FileCMXS -> "cmxs" | FileCMT -> "cmt" | FileCMTI -> "cmti" | FileO -> "o" | FileA -> "a" | FileSO -> "so" | FileEXE -> "exe" | FileOther s -> s type id = { fdep_ty : t; fdep_path : filepath } let make_id (ty,p) = { fdep_ty = ty; fdep_path = p } let get_id fdep = (fdep.fdep_ty, fdep.fdep_path) let get_type fdep = fdep.fdep_ty let get_path fdep = fdep.fdep_path let of_filename (name : filename) : t = try let nameUnpack = fn_to_string name in let len = String.length (Filename.chop_extension nameUnpack) in (* +1 to remove the dot *) of_string (String.sub nameUnpack (len+1) (String.length nameUnpack - len - 1)) with Invalid_argument _ -> FileEXE (* best effort, suit our case for unix *) let of_filepath (path : filepath) : t = of_filename (path_basename path) let replace_extension (name:filename) ext = let extStr = to_string ext in try let choppedName = Filename.chop_extension (fn_to_string name) in fn (String.concat "." [ choppedName; extStr ]) with Invalid_argument _ -> fn (fn_to_string name ^ "." ^ extStr) let replace_extension_path path ext = let dir = path_dirname path in dir replace_extension (path_basename path) ext obuild-obuild-v0.1.10/obuild/findlibConf.ml000066400000000000000000000032551327005302600205410ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext type t = { path : filepath list; destdir : filepath option; all : (string * string option) list; loaded : bool } let default = { all = []; path = []; destdir = None; loaded = false } let conf = ref default let parse_file path = let content = Filesystem.readFile path in let unquote s = match s with | None -> failwith ("unknown configuration key with no value") | Some x -> string_init 1 (string_drop 1 x) in let kvs = List.map Utils.toKVeq (string_lines_noempty content) in let paths = string_split ':' (unquote (List.assoc "path" kvs)) in let destdir = unquote (List.assoc "destdir" kvs) in { all = kvs; path = List.map fp paths; destdir = Some (fp destdir); loaded = true; } let get_program_config () = match Process.run [ "ocamlfind"; "printconf"; "conf" ] with | Process.Failure err -> failwith ("ocamlfind printconf failed err " ^ err) | Process.Success (out,_,_) -> match string_lines_noempty out with | [x] -> [fp x] | _ -> failwith ("ocamlfind printconf failed output: " ^ out) let get_paths () = try [fp (Sys.getenv "OCAMLFIND_CONF")] with Not_found -> try get_program_config () with _ -> [ fp "/etc/findlib.conf"; fp "/etc/ocamlfind.conf" ] let get_system () = let paths = get_paths () in try let found_path = List.find Filesystem.exists paths in parse_file found_path with Not_found -> default let load () = match Gconf.get_env ("findlib-path") with | None -> conf := get_system () | Some p -> conf := parse_file (fp p) let get_paths () = (!conf).path let get_destdir () = (!conf).destdir obuild-obuild-v0.1.10/obuild/gconf.ml000066400000000000000000000050771327005302600174240ustar00rootroot00000000000000open Ext.Fugue type verbosity_t = Silent | Report | Verbose | Debug | DebugPlus type t = { mutable verbosity : verbosity_t; mutable strict : bool; mutable parallel_jobs : int; mutable dump_dot : bool; mutable color : bool; mutable bin_annot : bool; mutable short_path : bool; mutable ocamlmklib : bool; mutable ocaml_extra_args : string list; } exception UnknownOption of string let env_variables = [ "ocamlopt"; "ocamlc"; "ocaml"; "ocamldep"; "ocamldoc"; "ocamlyacc"; "ocamllex"; "ocamlmklib"; "ocamlmktop"; "cc"; "ranlib"; "ar"; "ld"; "pkg-config"; "camlp4"; "findlib-path"; "atdgen" ] let env_ = let h : (string,string option) Hashtbl.t = Hashtbl.create (List.length env_variables) in List.iter (fun v -> Hashtbl.add h v None) env_variables; h let get_env field = try Hashtbl.find env_ field with Not_found -> raise (UnknownOption field) let set_env field value = if not (Hashtbl.mem env_ field) then raise (UnknownOption field); Hashtbl.replace env_ field (Some value) let target_options_defaults = [ ("executable-profiling", false); ("executable-debugging", false); ("executable-native", true); ("executable-bytecode", false); ("executable-as-obj", false); ("library-profiling", false); ("library-debugging", false); ("library-native", true); ("library-bytecode", true); ("library-plugin", (if Sys.os_type = "Unix" then true else false)); ("build-benchs", false); ("build-tests", false); ("build-examples", false); ("annot", false); ] let target_options_ = let h = Hashtbl.create (List.length target_options_defaults) in List.iter (fun (k,v) -> Hashtbl.add h k v) target_options_defaults; h let rec set_target_options field value = if not (Hashtbl.mem target_options_ field) then raise (UnknownOption field); Hashtbl.replace target_options_ field value; (match field,value with | "executable-profiling", true -> set_target_options "library-profiling" true | "executable-debugging", true -> set_target_options "library-debugging" true | "library-plugin", true -> set_target_options "library-native" true | _ -> ()) let get_target_options_keys () = hashtbl_keys target_options_ let get_target_options () = hashtbl_toList target_options_ let get_target_option field = try Hashtbl.find target_options_ field with Not_found -> raise (UnknownOption field) let defaults = { verbosity = Report; strict = false; parallel_jobs = 2; dump_dot = false; color = false; bin_annot = true; short_path = false; ocamlmklib = true; ocaml_extra_args = []; } let gconf = defaults obuild-obuild-v0.1.10/obuild/generators.ml000066400000000000000000000054561327005302600205020ustar00rootroot00000000000000open Ext.Filepath open Helper open Gconf exception GeneratorFailed of string exception GeneratorNotFound of string type t = { suffix : string; modname : (Modname.t -> Modname.t); commands : (filepath -> filepath -> string -> string list list); generated_files : (filename -> string -> filename); } let generators = ref [ { suffix = "mll"; modname = (fun m -> m); commands = (fun src dest_root _ -> [[Prog.getOcamlLex (); "-o"; (fp_to_string dest_root) ^ ".ml"; fp_to_string src]]); generated_files = (fun f _ -> (chop_extension f) <.> "ml") }; { suffix = "mly"; modname = (fun m -> m); commands = (fun src dest_root _ -> [[Prog.getOcamlYacc (); "-b"; fp_to_string dest_root; fp_to_string src]]); generated_files = (fun f _ -> (chop_extension f) <.> "ml") }; { suffix = "atd"; modname = (fun m -> Modname.atd_modname m); commands = (fun src dest_root moduleName -> let len = String.length moduleName in let ext = String.sub moduleName (len - 2) 2 in match ext with | "_t" -> [[Prog.getAtdGen (); "-t"; fp_to_string src; "-o"; (fp_to_string dest_root)]] | "_v" -> [[Prog.getAtdGen (); "-v"; fp_to_string src; "-o"; (fp_to_string dest_root)]] | "_j" -> [[Prog.getAtdGen (); "-j"; "-j-std"; fp_to_string src; "-o"; (fp_to_string dest_root)]] | _ -> raise (GeneratorFailed ("extension " ^ ext ^ " is unknown")) ); generated_files = (fun f moduleName -> let base = fn_to_string (chop_extension f) in let len = String.length moduleName in let ext = String.sub moduleName (len - 2) 2 in match ext with | "_t" -> fn (base ^ "_t.ml") | "_v" -> fn (base ^ "_v.ml") | "_j" -> fn (base ^ "_j.ml") | _ -> raise (GeneratorFailed ("extension " ^ ext ^ " is unknown")) ) }; ] let is_generator_ext ext = List.exists (fun gen -> gen.suffix = ext) !generators let get_generator fp = let ext = Filetype.of_filepath fp in let s = match ext with Filetype.FileOther s -> s | _ -> raise (GeneratorNotFound (fp_to_string fp)) in List.find (fun gen -> gen.suffix = s) !generators let run dest src modName = verbose Debug " generator dest = %s src = %s\n%!" (fp_to_string dest) (fp_to_string src); let gen = get_generator src in let args = gen.commands src dest modName in List.iter (fun arg -> match Process.run arg with | Process.Success (_, warnings,_) -> print_warnings warnings | Process.Failure er -> raise (GeneratorFailed er) ) args obuild-obuild-v0.1.10/obuild/helper.ml000066400000000000000000000015501327005302600175770ustar00rootroot00000000000000open Printf open Gconf let print_warnings warnings = if warnings <> "" then fprintf stderr "%s\n%!" warnings else () let log lvl fmt = if lvl <= gconf.verbosity then printf fmt else ifprintf stdout fmt let debug fmt = log Gconf.Debug fmt let report fmt = log Gconf.Report fmt (* deprecated, replace by other stuff *) let verbose lvl fmt = if lvl <= gconf.verbosity then printf fmt else ifprintf stdout fmt let support_color () = if Utils.isWindows then false else if Unix.isatty Unix.stdout then Gconf.gconf.color else false let color_red () = if support_color () then "\x1b[1;31m" else "" let color_green () = if support_color () then "\x1b[1;32m" else "" let color_blue () = if support_color () then "\x1b[1;34m" else "" let color_white () = if support_color () then "\x1b[0m" else "" obuild-obuild-v0.1.10/obuild/hier.ml000066400000000000000000000154641327005302600172600ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Types exception EmptyModuleHierarchy type t = Modname.t list (* first filepath is the source path, second is the actual path *) type file_entry = FileEntry of (filepath * filepath) (* root_path, full_path *) | GeneratedFileEntry of (filepath * filepath * filename) (* root_path, full_path, generated_path *) | DirectoryEntry of (filepath * filepath) (* root_path, full_path *) let file_entry_to_string = function | FileEntry (p, f) -> Printf.sprintf "FileEntry %s %s" (fp_to_string p) (fp_to_string f) | DirectoryEntry (p, f) -> Printf.sprintf "DirectoryEntry %s %s" (fp_to_string p) (fp_to_string f) | GeneratedFileEntry (p,f,n) -> Printf.sprintf "GeneratedFileEntry %s %s %s" (fp_to_string p) (fp_to_string f) (fn_to_string n) let hiers : (t, file_entry) Hashtbl.t = Hashtbl.create 128 let root = List.hd let parent x = match x with | [] -> assert false | [_] -> None | l -> Some (list_init l) let leaf = list_last let make l = if l = [] then raise EmptyModuleHierarchy else l let lvl x = List.length x - 1 let to_string x = String.concat "." (List.map Modname.to_string x) let of_string x = let l = string_split '.' x in make (List.map Modname.of_string l) let ml_to_ext path ext = let f = path_basename path in let d = path_dirname path in d ((chop_extension f) <.> (Filetype.to_string ext)) let of_modname x = [x] let to_node x = x let to_dirpath x = if List.length x > 1 then fp (String.concat Filename.dir_sep (List.map Modname.to_dir $ list_init x)) else currentDir let append x m = x @ [m] let add_prefix prefix_path hier = if List.length hier <= 1 then prefix_path else begin let to_fp = fp (String.concat Filename.dir_sep (List.map Modname.to_dir $ list_init hier)) in if (path_length prefix_path) = 0 then to_fp else let rec loop path hier_list = match hier_list with | [] -> path to_fp | x :: xs -> if (path_basename path) = fn (Modname.to_dir x) then if (path_length prefix_path) = 1 then to_fp (* prefix_path is fully included in hier *) else loop (path_dirname path) xs else path to_fp in loop prefix_path (List.tl (List.rev hier)) end let check_file path filename ext = if ext <> Filetype.FileOther "" then Ext.Filesystem.exists (path ((fn filename) <.> (Filetype.to_string ext))) else Ext.Filesystem.exists (path (fn filename)) let check_modname path modname ext = if (check_file path modname ext) then Some modname else let name = String.uncapitalize modname in if (check_file path name ext) then Some name else None let get_filepath root_path hier ext : file_entry option = if (Hashtbl.mem hiers hier) then Some (Hashtbl.find hiers hier) else let path = add_prefix root_path hier in let modname = Modname.to_string (leaf hier) in let res = check_modname path modname ext in match res with | None -> None | Some name -> let entry = if ext <> Filetype.FileOther "" then FileEntry (root_path, path ((fn name) <.> (Filetype.to_string ext))) else DirectoryEntry (root_path, path (fn name)) in Hashtbl.add hiers hier entry; Some entry let to_filename hier prefix_path = get_filepath prefix_path hier Filetype.FileML let to_directory hier prefix_path = get_filepath prefix_path hier (Filetype.FileOther "") let to_generators hier prefix_path = if (Hashtbl.mem hiers hier) then Some (Hashtbl.find hiers hier) else try Some (list_findmap (fun gen -> let path = add_prefix prefix_path hier in let modname = Modname.to_string (leaf hier) in let modname = gen.Generators.modname modname in let ext = Filetype.FileOther gen.Generators.suffix in let res = check_modname path modname ext in match res with | None -> None | Some name -> let filename = (fn name) <.> (Filetype.to_string ext) in let fullname = path filename in let generated_file = gen.Generators.generated_files filename (Modname.to_string (leaf hier)) in Hashtbl.add hiers hier (GeneratedFileEntry (prefix_path, fullname, generated_file)); Some (GeneratedFileEntry (prefix_path, fullname, generated_file)) ) !Generators.generators) with Not_found -> None let get_src_file dst_dir = function | FileEntry (_,f) -> f | GeneratedFileEntry (_,_,fn) -> dst_dir fn | DirectoryEntry (_,f) -> f let get_dest_file dst_dir ext hier = let entry = Hashtbl.find hiers hier in match entry with | FileEntry (_,f) -> let filename = path_basename f in let path = add_prefix dst_dir hier in path ((chop_extension filename) <.> Filetype.to_string ext) | GeneratedFileEntry (_,_,filename) -> let path = add_prefix dst_dir hier in path ((chop_extension filename) <.> Filetype.to_string ext) | DirectoryEntry (_,f) -> let filename = path_basename f in let path = add_prefix dst_dir hier in path (filename <.> Filetype.to_string ext) let get_dest_file_ext dst_dir hier ext_f = let entry = Hashtbl.find hiers hier in match entry with | FileEntry (_,f) -> let filename = path_basename f in let filetype = Filetype.of_filepath f in let path = add_prefix dst_dir hier in path ((chop_extension filename) <.> Filetype.to_string (ext_f filetype)) | GeneratedFileEntry (_,_,filename) -> let path = add_prefix dst_dir hier in let filetype = Filetype.of_filename filename in path ((chop_extension filename) <.> Filetype.to_string (ext_f filetype)) | DirectoryEntry (_,f) -> let filename = path_basename f in let path = add_prefix dst_dir hier in let filetype = Filetype.of_filepath f in path (filename <.> Filetype.to_string (ext_f filetype)) let to_interface hier prefix_path = get_filepath prefix_path hier Filetype.FileMLI let get_file_entry_maybe hier = if (Hashtbl.mem hiers hier) then Some (Hashtbl.find hiers hier) else None let get_file_entry hier paths = if (Hashtbl.mem hiers hier) then Hashtbl.find hiers hier else list_findmap (fun path -> try Some (list_findmap (fun lookup -> lookup hier path) [to_filename; to_directory; to_generators; to_interface]) with Not_found -> None ) paths let of_filename filename = let name = Filename.chop_extension (fn_to_string filename) in let m = try Modname.wrap (String.capitalize name) with Modname.EmptyModuleName -> raise (Modname.ModuleFilenameNotValid (fn_to_string filename)) | Invalid_argument _ -> raise (Modname.ModuleFilenameNotValid (fn_to_string filename)) in make [m] obuild-obuild-v0.1.10/obuild/libname.ml000066400000000000000000000022661327005302600177340ustar00rootroot00000000000000open Ext.Fugue open Types open Ext.Filepath exception EmptyLibName (* represent a library in a form abc[.def.xyz] *) type t = { main_name : string; subnames : string list } let of_string s = match string_split '.' s with | [] -> raise EmptyLibName | x::xs -> { main_name = x; subnames = xs } let to_string lname = String.concat "." (lname.main_name :: lname.subnames) let to_string_nodes lname = lname.main_name :: lname.subnames let append lname sub = { lname with subnames = lname.subnames @ [sub] } let to_libstring lib = String.concat "_" (to_string_nodes lib) let to_cmxs (compileType: ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cmxs") let to_cmxa (compileType: ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cmxa") let to_cma (compileType: ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cma") let to_cmca b = if b = Native then to_cmxa else to_cma (* only used for stdlib stuff *) (* let of_cmca b file = let suffix = if b = Native then ".cmxa" else ".cma" in Filename.chop_suffix (fn_to_string file) suffix *) obuild-obuild-v0.1.10/obuild/meta.ml000066400000000000000000000416331327005302600172540ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext open Printf open Helper open Gconf module Predicate = struct type t = | Byte | Native | Toploop | CreateToploop | Plugin | Mt | Mt_vm | Mt_posix | Gprof | Autolink | Syntax | Preprocessor | Camlp4o | Camlp4r | Ppx_driver | Neg of t | Unknown of string let rec to_string = function | Byte -> "byte" | Native -> "native" | Toploop -> "toploop" | CreateToploop -> "create_toploop" | Plugin -> "plugin" | Mt -> "mt" | Mt_vm -> "mt_vm" | Mt_posix -> "mt_posix" | Gprof -> "gprof" | Autolink -> "autolink" | Syntax -> "syntax" | Preprocessor -> "preprocessor" | Camlp4o -> "camlp4o" | Camlp4r -> "camlp4r" | Ppx_driver -> "ppx_driver" | Neg t -> "-" ^ (to_string t) | Unknown s -> s let rec of_string s = if s.[0] = '-' then Neg (of_string (String.sub s 1 ((String.length s) - 1))) else match s with | "byte" -> Byte | "native" -> Native | "toploop" -> Toploop | "create_toploop" -> CreateToploop | "plugin" -> Plugin | "mt" -> Mt | "mt_vm" -> Mt_vm | "mt_posix" -> Mt_posix | "gprof" -> Gprof | "autolink" -> Autolink | "syntax" -> Syntax | "preprocessor" -> Preprocessor | "camlp4o" -> Camlp4o | "camlp4r" -> Camlp4r | "ppx_driver" -> Ppx_driver | _ as s -> Unknown s end exception LibraryNotFound of string exception SubpackageNotFound of string exception ArchiveNotFound of filepath * Libname.t * (Predicate.t list) exception MetaParseError of filepath * string module Pkg = struct (* preliminaries structures, adjust as needed by meta. *) type t = { name : string; requires : (Predicate.t list * Libname.t list) list; directory : string; description : string; exists_if : string; preprocessor : string; ppx : (Predicate.t list * string) option; ppxopt : (Predicate.t list * string) list; browse_interface : string; type_of_threads : string; archives : (Predicate.t list * string) list; warning : (Predicate.t list * string) list; append_archives : (Predicate.t list * string) list; version : string; assignment : (string * string) list; linkopts : (Predicate.t list option * string) list; subs : t list; } let make name = { name; requires = []; directory = ""; description = ""; preprocessor = ""; ppx = None; ppxopt = []; linkopts = []; browse_interface = ""; type_of_threads = ""; exists_if = ""; archives = []; append_archives = []; warning = []; version = ""; assignment = []; subs = []; } let rec iter f package = f package; List.iter (iter f) package.subs let rec find subs pkg = match subs with | [] -> pkg | x::xs -> find xs (try List.find (fun spkg -> spkg.name = x) pkg.subs with Not_found -> raise (SubpackageNotFound x)) let get_syntaxes pkg = list_filter_map (fun (preds,s) -> if List.mem Predicate.Syntax preds then Some (list_remove Predicate.Syntax preds, s) else None ) pkg.archives let satisfy preds constraints = List.for_all (fun p -> match p with Predicate.Neg n -> not (List.mem n constraints) | _ -> List.mem p constraints) preds let is_syntax_ pkg = List.length (get_syntaxes pkg) > 0 let is_syntax (_, rootPkg) dep = is_syntax_ (find dep.Libname.subnames rootPkg) let get_archive_with_filter (_, root) dep preds = let pkg = find dep.Libname.subnames root in let fulfills archive_preds = List.for_all (fun p -> match p with Predicate.Neg n -> not (List.mem n preds) | _ -> List.mem p preds) archive_preds in let rec best_archive best_n best_value archives = match archives with | [] -> if best_n >= 0 then [best_value] else [] | ((archive_preds,_) as archive) :: rest -> if (fulfills archive_preds) && ((List.length archive_preds) > best_n) then best_archive (List.length archive_preds) archive rest else best_archive best_n best_value rest in let rec all_append_archives archives = match archives with | [] -> [] | ((archive_preds,_) as archive) :: rest -> if (fulfills archive_preds) then archive :: (all_append_archives rest) else all_append_archives rest in let res = if pkg.archives = [] then [] else best_archive (-1) (List.hd pkg.archives) pkg.archives in res @ (all_append_archives pkg.append_archives) let get_archive (path, root) dep preds = let pkg = find dep.Libname.subnames root in try snd (List.find (fun (e,_) -> list_eq_noorder e preds) pkg.archives) with Not_found -> raise (ArchiveNotFound (path, dep, preds)) let write path package = let out = Buffer.create 1024 in let append = Buffer.add_string out in let preds_to_string preds = if preds = [] then "" else "(" ^ (String.concat "," (List.map Predicate.to_string preds)) ^ ")" in let rec write_one indent pkg = let indent_str = String.make indent ' ' in let output_field field name = if field <> "" then append (sprintf "%s%s = \"%s\"\n" indent_str name field); in output_field pkg.description "description"; output_field pkg.version "version"; output_field pkg.browse_interface "browse_interface"; output_field pkg.exists_if "exists_if"; List.iter (fun (preds,deps) -> let dep_str = String.concat "," (List.map (fun dep -> Libname.to_string dep) deps) in append (sprintf "%srequires%s = \"%s\"\n" indent_str (preds_to_string preds) dep_str); ) pkg.requires; List.iter (fun (preds,v) -> append (sprintf "%sarchive%s = \"%s\"\n" indent_str (preds_to_string preds) v) ) pkg.archives; List.iter (fun (preds,v) -> append (sprintf "%sarchive%s += \"%s\"\n" indent_str (preds_to_string preds) v) ) pkg.append_archives; List.iter (fun spkg -> append (sprintf "%spackage \"%s\" (\n" indent_str spkg.name); write_one (indent+2) spkg; append (sprintf "%s)\n" indent_str) ) pkg.subs in write_one 0 package; Filesystem.writeFile path (Buffer.contents out) end type t = filepath * Pkg.t let path_warning = ref false module Token = struct (* mini lexer *) type t = | ID of string | S of string | LPAREN | RPAREN | MINUS | DOT | EQ | PLUSEQ | COMMA let to_string = function | (ID s) -> "ID[" ^ s ^ "]" | (S s) -> "\"" ^ s ^ "\"" | LPAREN -> "(" | RPAREN -> ")" | MINUS -> "-" | DOT -> "." | EQ -> "=" | PLUSEQ -> "+=" | COMMA -> "," let char_table = hashtbl_fromList [('(', LPAREN); (')', RPAREN); ('=', EQ); (',', COMMA); ('.', DOT); ('-', MINUS)] let is_token_char c = Hashtbl.mem char_table c let get_token_char c = Hashtbl.find char_table c let is_ident_char c = char_is_alphanum c || c == '_' || c == '-' let tokenize name s = let line = ref 1 in let lineoff = ref 0 in let len = String.length s in let eat_comment o = let i = ref (o+1) in while !i < len && s.[!i] <> '\n' do i := !i+1 done; line := !line + 1; lineoff := !i+1; (!i+1) in let parse_ident o = let i = ref (o+1) in while !i < len && is_ident_char s.[!i] do i := !i+1 done; (String.sub s o (!i-o),!i) in let parse_string o = let i = ref (o+1) in let buf = Buffer.create 32 in let in_escape = ref false in while !i < len && (!in_escape || s.[!i] <> '"') do if not !in_escape && s.[!i] = '\\' then in_escape := true else begin let c = if !in_escape then match s.[!i] with | '\\' -> '\\' | 'n' -> '\n' | 't' -> '\t' | 'r' -> '\r' | '"' -> '"' | _ -> s.[!i] else s.[!i] in in_escape := false; Buffer.add_char buf c end; i := !i+1 done; (Buffer.contents buf, !i+1) in let rec loop o = if o >= len then [] else begin if s.[o] == ' ' || s.[o] == '\t' then loop (o+1) else if s.[o] == '\n' then ( line := !line + 1; lineoff := o+1; loop (o+1) ) else if s.[o] == '#' then loop (eat_comment o) else if s.[o] == '"' then let (s, no) = parse_string o in S s :: loop no else if is_token_char s.[o] then get_token_char s.[o] :: loop (o+1) else if s.[o] == '+' && (o+1) < len && s.[o+1] == '=' then PLUSEQ :: loop (o+2) else if (s.[o] >= 'a' && s.[o] <= 'z') || (s.[o] >= 'A' && s.[o] <= 'Z') || s.[o] == '-' then let (id, no) = parse_ident o in ID id :: loop no else let s = sprintf "%d.%d: meta lexing error: undefined character '%c'" !line (o - !lineoff) s.[o] in raise (MetaParseError (name, s)) end in loop 0 let rec parse_predicate = function | COMMA :: ID s :: xs -> let (l, r) = parse_predicate xs in ((Predicate.of_string s) :: l, r) | COMMA :: MINUS :: ID s :: xs -> let (l, r) = parse_predicate xs in ((Predicate.Neg (Predicate.of_string s)) :: l, r) | xs -> ([], xs) let parse_predicate_list name field = function | LPAREN :: RPAREN :: xs -> ([], xs) | LPAREN :: ID s :: xs -> (let (preds, xs2) = parse_predicate xs in match xs2 with | RPAREN :: xs3 -> ((Predicate.of_string s) :: preds, xs3) | _ -> raise (MetaParseError (name, ("expecting ')' after " ^ field ^ "'s predicate"))) ) | LPAREN :: MINUS :: ID s :: xs -> (let (preds, xs2) = parse_predicate xs in match xs2 with | RPAREN :: xs3 -> ((Predicate.Neg (Predicate.of_string s)) :: preds, xs3) | _ -> raise (MetaParseError (name, ("expecting ')' after " ^ field ^ "'s predicate"))) ) | xs -> ([], xs) let rec parse pkg_name acc = function | [] -> (acc, []) | RPAREN :: xs -> (acc, xs) | ID "package" :: S name :: LPAREN :: xs -> (let (pkg, xs2) = parse pkg_name (Pkg.make name) xs in let nacc = { acc with Pkg.subs = acc.Pkg.subs @ [pkg]} in parse pkg_name nacc xs2 ) | ID "requires" :: xs -> ( let (preds, xs2) = parse_predicate_list pkg_name "requires" xs in match xs2 with | PLUSEQ :: S reqs :: xs3 | EQ :: S reqs :: xs3 -> let deps = List.map (fun r -> Libname.of_string r) $ (List.filter (fun x -> x <> "") $ string_split_pred (fun c -> List.mem c [',';' ']) reqs) in parse pkg_name { acc with Pkg.requires = (preds, (List.rev deps)) :: acc.Pkg.requires } xs3 | _ -> raise (MetaParseError (pkg_name, "parsing requires failed")) ) | ID "directory" :: EQ :: S dir :: xs -> parse pkg_name { acc with Pkg.directory = dir } xs | ID "description" :: EQ :: S dir :: xs -> parse pkg_name { acc with Pkg.description = dir } xs | ID "browse_interfaces" :: EQ :: S _ :: xs -> parse pkg_name acc xs | ID "warning" :: xs -> ( let (preds, xs2) = parse_predicate_list pkg_name "archive" xs in match xs2 with | EQ :: S v :: xs3 -> let nacc = { acc with Pkg.warning = acc.Pkg.warning @ [(preds, v)] } in parse pkg_name nacc xs3 | _ -> raise (MetaParseError (pkg_name, "parsing warning failed")) ) | ID "archive" :: xs -> ( let (preds, xs2) = parse_predicate_list pkg_name "archive" xs in match xs2 with | PLUSEQ :: S v :: xs3 -> let nacc = { acc with Pkg.append_archives = acc.Pkg.append_archives @ [(preds, v)] } in parse pkg_name nacc xs3 | EQ :: S v :: xs3 -> let nacc = { acc with Pkg.archives = acc.Pkg.archives @ [(preds, v)] } in parse pkg_name nacc xs3 | _ -> raise (MetaParseError (pkg_name, "parsing archive failed")) ) | ID "plugin" :: xs -> ( let (preds, xs2) = parse_predicate_list pkg_name "plugin" xs in let preds = Predicate.Plugin :: preds in match xs2 with | PLUSEQ :: S v :: xs3 -> let nacc = { acc with Pkg.append_archives = acc.Pkg.append_archives @ [(preds, v)] } in parse pkg_name nacc xs3 | EQ :: S v :: xs3 -> let nacc = { acc with Pkg.archives = acc.Pkg.archives @ [(preds, v)] } in parse pkg_name nacc xs3 | _ -> raise (MetaParseError (pkg_name, "parsing plugin failed")) ) | ID "preprocessor" :: EQ :: S v :: xs -> parse pkg_name { acc with Pkg.preprocessor = v } xs | ID "ppx" :: xs -> ( let (preds, xs2) = parse_predicate_list pkg_name "ppx" xs in match xs2 with | EQ :: S v :: xs3 -> parse pkg_name { acc with Pkg.ppx = Some (preds, v)} xs3 | _ -> raise (MetaParseError (pkg_name, "parsing ppx failed")) ) | ID "ppxopt" :: xs -> ( let (preds, xs2) = parse_predicate_list pkg_name "ppxopt" xs in match xs2 with | PLUSEQ :: S v :: xs3 | EQ :: S v :: xs3 -> parse pkg_name { acc with Pkg.ppxopt = acc.Pkg.ppxopt @ [(preds, v)]} xs3 | _ -> raise (MetaParseError (pkg_name, "parsing ppxopt failed")) ) | ID "version" :: EQ :: S v :: xs -> parse pkg_name { acc with Pkg.version = v } xs | ID "exists_if" :: EQ :: S v :: xs -> parse pkg_name { acc with Pkg.exists_if = v } xs | ID "error" :: LPAREN :: xs -> ( let rec consume = function | RPAREN::zs -> zs | _::zs -> consume zs | [] -> failwith "eof in error context" in match consume xs with | EQ :: S _ :: xs2 -> parse pkg_name acc xs2 | _ -> failwith "parsing error failed" ) | ID "linkopts" :: xs -> ( let (preds, xs2) = parse_predicate_list pkg_name "linkopts" xs in match xs2 with | EQ :: S s :: xs3 -> parse pkg_name { acc with Pkg.linkopts = ((if preds = [] then None else Some preds), s) :: acc.Pkg.linkopts } xs3 | _ -> failwith "parsing linkopts failed, expecting equal" ) | ID stuff :: EQ :: S stuffVal :: xs -> parse pkg_name { acc with Pkg.assignment = (stuff, stuffVal) :: acc.Pkg.assignment } xs | x :: xs -> raise (MetaParseError (pkg_name, ("unknown token '" ^ to_string x ^ "' in meta file\n" ^ (String.concat " " (List.map to_string xs))))) end (* meta files are supposed to be small, so don't bother with * a real efficient and incremental read/lex/parse routine. * * this can be improve later on-needed basis *) let parse name content pkg_name = fst (Token.parse name (Pkg.make pkg_name) (Token.tokenize name content)) let read path name = let meta_content = Filesystem.readFile path in parse path meta_content name (* get the META file path associated to a library *) let findLibPath name = if !path_warning then ( eprintf "warning: obuild META search paths and ocaml config mismatch\n\n"; eprintf " The ocamlfind configuration file used doesn't list the ocaml standard library \n"; eprintf " as part of his search paths. something fishy is going on\n"; eprintf " You can solve the issue by:\n"; eprintf " * pointing OCAMLFIND_CONF environment to the right configuration file\n"; eprintf " * making sure that the ocamlfind program in your path is the right one (ocamlfind printconf)\n"; eprintf "\n"; eprintf " this is likely to cause various compilation problems\n"; (* then we ignore further warnings *) path_warning := false ); let rec find_ret l = match l with | [] -> raise (LibraryNotFound name) | p::ps -> let inDir = (p fn name) fn "META" in let asMetaext = p (fn ("META") <.> name) in if Filesystem.exists inDir then inDir else if Filesystem.exists asMetaext then asMetaext else find_ret ps in find_ret (FindlibConf.get_paths ()) let findLib name : t = let path = findLibPath name in (path, read path name) let getIncludeDir stdlib ((path, pkg) : t) : filepath = match pkg.Pkg.directory with | "" | "." -> path_dirname path | "^" -> path_dirname (path_dirname path) | o -> match o.[0] with | '^' -> path_dirname (path_dirname path) fp (string_drop 1 o) | '+' -> stdlib fp (string_drop 1 o) | _ -> fp o obuild-obuild-v0.1.10/obuild/metacache.ml000066400000000000000000000014161327005302600202330ustar00rootroot00000000000000open Meta open Gconf open Helper let pkgs_cache : (string, Meta.t) Hashtbl.t = Hashtbl.create 100 let get_from_disk name = verbose Debug " fetching META %s\n%!" name; try Meta.findLib name with Meta.LibraryNotFound n -> raise (Dependencies.DependencyMissing n) let get name = try Hashtbl.find pkgs_cache name with Not_found -> let r = get_from_disk name in Hashtbl.add pkgs_cache name r; r let get_from_cache lib = try Hashtbl.find pkgs_cache lib.Libname.main_name with Not_found -> failwith (Printf.sprintf "package %s not found in the hashtbl: internal error" (Libname.to_string lib)) let add name meta = Hashtbl.add pkgs_cache name meta let find name = try Some (Hashtbl.find pkgs_cache name) with Not_found -> None obuild-obuild-v0.1.10/obuild/modname.ml000066400000000000000000000032271327005302600177430ustar00rootroot00000000000000open Ext.Filepath open Ext.Fugue type t = string exception InvalidModuleName of string exception EmptyModuleName exception ModuleFilenameNotValid of string let char_isalpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') let char_is_valid_modchar c = char_isalpha c || (c >= '0' && c <= '9') || c == '_' let string_all p s = let valid = ref true in for i = 0 to String.length s - 1 do valid := !valid && p s.[i] done; !valid let wrap x = if String.length x = 0 then (raise EmptyModuleName) else if not (string_all char_is_valid_modchar x) then (raise (InvalidModuleName x)) else if Char.uppercase x.[0] <> x.[0] then (raise (InvalidModuleName x)) else x let of_string x = wrap x let to_string x = x let to_dir x = String.uncapitalize x let to_x ext modname = fn (String.uncapitalize modname ^ ext) let to_o = to_x ".o" let to_directory = to_x "" let to_filename = to_x ".ml" let to_parser = to_x ".mly" let to_lexer = to_x ".mll" let atd_modname modname = if (String.length modname) > 2 then let (b,e) = string_splitAt ((String.length modname) - 2) modname in match e with | "_t" | "_v" | "_j" -> b | _ -> modname else modname let to_atd modname = to_x ".atd" (atd_modname modname) let module_lookup_methods = [ to_directory; to_parser; to_lexer; to_atd; to_filename ] let of_directory filename = wrap (String.capitalize (fn_to_string filename)) let of_filename filename = try wrap (String.capitalize (Filename.chop_extension (fn_to_string filename))) with EmptyModuleName -> raise (ModuleFilenameNotValid (fn_to_string filename)) | Invalid_argument _ -> raise (ModuleFilenameNotValid (fn_to_string filename)) obuild-obuild-v0.1.10/obuild/pp.ml000066400000000000000000000016011327005302600167340ustar00rootroot00000000000000open Ext.Fugue exception InvalidPreprocessor of string (* http://ocaml.org/tutorials/camlp4_3.10.html *) type package = string list module Type = struct type t = CamlP4O | CamlP4R let of_string s = match String.lowercase s with | "p4o" | "camlp4o" -> CamlP4O | "p4r" | "camlp4r" -> CamlP4R | _ -> raise (InvalidPreprocessor s) let to_string = function | CamlP4O -> "camlp4o" | CamlP4R -> "camlp4r" end type desc = { camlp4 : string; packages : package list } type t = desc option let some s pkgs = Some { camlp4 = s; packages = pkgs } let none = None let append pp pkgs = match pp with | None -> pp | Some d -> Some { d with packages = d.packages @ pkgs } let to_params pp = maybe [] (fun desc -> let s = desc.camlp4 ^ " " ^ String.concat " " (List.concat (List.map (fun x -> x) desc.packages)) in ["-pp"; s ] ) pp obuild-obuild-v0.1.10/obuild/prepare.ml000066400000000000000000000615601327005302600177650ustar00rootroot00000000000000(* * gather dependencies in hashtable and DAGs * and create compilation state for one target *) open Ext.Fugue open Ext.Filepath open Ext open Analyze open Types open Helper open Gconf open Target open Dependencies type use_thread_flag = NoThread | WithThread type thread_type = VMThread | PosixThread | DefaultThread | NoThreads type ocaml_file_type = GeneratedModule | SimpleModule module Module = struct exception DependsItself of Hier.t exception DependenciesProblem of Hier.t list exception DependencyNoOutput exception NotFound of (filepath list * Hier.t) module Intf = struct type t = { mtime : float; path : filepath } let make mtime path = { mtime; path } end module File = struct type t = { use_threads : use_thread_flag; path : filepath; mtime : float; type_ : ocaml_file_type; intf_desc : Intf.t option; use_pp : Pp.t; oflags : string list; dep_cwd_modules : Hier.t list; dep_other_modules : Modname.t list; } let make use_threads path mtime type_ intf_desc use_pp oflags dep_cwd_modules dep_other_modules = { use_threads; path; mtime; type_; intf_desc; use_pp; oflags; dep_cwd_modules; dep_other_modules } end module Dir = struct type t = { path : filepath; modules : Hier.t list } let make path modules = {path; modules} end type t = DescFile of File.t | DescDir of Dir.t let file_has_interface mdescfile = maybe false (fun _ -> true) mdescfile.File.intf_desc let has_interface = function | DescFile dfile -> file_has_interface dfile | DescDir _ -> false let make_dir path modules = DescDir (Dir.make path modules) let make_file use_threads path mtime type_ intf_desc use_pp oflags dep_cwd_modules dep_other_modules = DescFile (File.make use_threads path mtime type_ intf_desc use_pp oflags dep_cwd_modules dep_other_modules) end (* live for the whole duration of a building process * which include compilations and linkings *) type build_state = { bstate_config : project_config } type dir_spec = { src_dir : filepath; dst_dir : filepath; include_dirs : filepath list; } type compile_step = CompileModule of Hier.t | CompileInterface of Hier.t | CompileDirectory of Hier.t | CompileC of filename | LinkTarget of target | CheckTarget of target let string_of_compile_step cs = match cs with | CompileDirectory x -> "dir " ^ (Hier.to_string x) | CompileModule x -> "mod " ^ (Hier.to_string x) | CompileInterface x -> "intf " ^ (Hier.to_string x) | CompileC x -> "C " ^ (fn_to_string x) | LinkTarget x -> "link " ^ (Target.get_target_name x) | CheckTarget x -> "check " ^ (Target.get_target_name x) (* represent a single compilation *) type compilation_state = { compilation_modules : (Hier.t, Module.t) Hashtbl.t; compilation_csources : filename list; compilation_dag : compile_step Dag.t; compilation_pp : Pp.t; compilation_filesdag : Filetype.id Dag.t; compilation_builddir_c : filepath; compilation_builddir_ml : Types.ocaml_compilation_option -> filepath; compilation_include_paths : Types.ocaml_compilation_option -> Hier.t -> filepath list; compilation_linking_paths : filepath list; compilation_linking_paths_d : filepath list; compilation_linking_paths_p : filepath list; compilation_c_include_paths : filepath list; compilation_c_linking_paths : filepath list; } let init project = { bstate_config = project } let get_compilation_order cstate = let filter_modules t : Hier.t option = match t with | (CompileC _) | (CompileInterface _) | (LinkTarget _) | (CheckTarget _) -> None | (CompileDirectory m) | (CompileModule m) -> if Hier.lvl m = 0 then Some m else None in list_filter_map filter_modules (Dagutils.linearize cstate.compilation_dag) let camlp4Libname = Libname.of_string "camlp4" let syntaxPredsCommon = [Meta.Predicate.Syntax;Meta.Predicate.Preprocessor] let get_p4pred = function | Pp.Type.CamlP4O -> Meta.Predicate.Camlp4o | Pp.Type.CamlP4R -> Meta.Predicate.Camlp4r let get_syntax_pp bstate preprocessor buildDeps = let conf = bstate.bstate_config in let p4pred = get_p4pred preprocessor in let stdlib = fp (get_ocaml_config_key "standard_library" conf) in list_filter_map (fun spkg -> if Analyze.is_pkg_internal conf spkg then ( let lib = Project.find_lib bstate.bstate_config.project_file spkg in if lib.Project.Library.syntax then ( (* TODO need to make sure that the bytecode option has been enabled for the syntax library *) let dir = Dist.get_build_exn (Dist.Target (Name.Lib lib.Project.Library.name)) in Some [fp_to_string (dir Libname.to_cmca ByteCode Normal lib.Project.Library.name) ] ) else None ) else ( let meta = Metacache.get_from_cache spkg in let preds = if spkg = camlp4Libname then p4pred :: syntaxPredsCommon else syntaxPredsCommon in if Meta.Pkg.is_syntax meta spkg then ( let includePath = Meta.getIncludeDir stdlib meta in Some ["-I"; fp_to_string includePath; Meta.Pkg.get_archive meta spkg preds] ) else None ) ) buildDeps let get_target_pp bstate target = function | None -> Pp.none | Some pp -> let conf = bstate.bstate_config in let nodes = List.rev (Taskdep.linearize conf.project_pkgdeps_dag Taskdep.FromParent [Analyze.Target target.target_name]) in let syntaxPkgs = list_filter_map (fun node -> match node with | Dependency dep -> Some dep | _ -> None ) nodes in verbose Verbose " all packages : [%s]\n%!" (Utils.showList "," Libname.to_string syntaxPkgs); let p4pred = get_p4pred pp in let p4Meta = Metacache.get_from_cache camlp4Libname in let preproc = (snd p4Meta).Meta.Pkg.preprocessor in let archive = [Meta.Pkg.get_archive p4Meta camlp4Libname (p4pred::syntaxPredsCommon)] in (*verbose Verbose " camlp4 strs: [%s]\n%!" (Utils.showList "] [" id camlp4Strs);*) let camlp4Strs = get_syntax_pp bstate pp syntaxPkgs in Pp.some preproc (archive :: camlp4Strs) (* get every module description * and their relationship with each other *) let get_modules_desc bstate target toplevelModules = let autogenDir = Dist.get_build_exn Dist.Autogen in let modulesDeps = Hashtbl.create 64 in let file_search_paths hier = (List.map (fun dir -> dir Hier.to_dirpath hier) target.target_obits.target_srcdir) @ [autogenDir] in let targetPP = get_target_pp bstate target target.target_obits.target_pp in let get_one hier = let moduleName = Hier.to_string hier in verbose Verbose "Analysing %s\n%!" moduleName; let file_entry = let paths = (file_search_paths hier) in try Hier.get_file_entry hier paths with Not_found -> raise (Module.NotFound (paths, hier)) in let (srcPath,srcDir) = match file_entry with | Hier.FileEntry (s, d) | Hier.DirectoryEntry (s, d) | Hier.GeneratedFileEntry (s, d, _) -> (s, d) in let module_desc_ty = if Filesystem.is_dir srcDir then ( let modules = Filesystem.list_dir_pred_map (fun f -> let fp = srcDir f in if Filesystem.is_dir fp then (* Should avoid directory such as .git/.svn etc. *) if not (Modname.string_all Modname.char_is_valid_modchar (fn_to_string f)) then None else Some (Modname.of_directory f) else (match Filetype.of_filepath fp with | Filetype.FileML -> Some (Modname.of_filename f) | Filetype.FileMLI -> if (Filesystem.exists (srcDir ((chop_extension f) <.> "ml"))) then None else (* lonely mli *) Some (Modname.of_filename f) | Filetype.FileOther s -> if Generators.is_generator_ext s then Some (Modname.of_filename f) else None | _ -> None ) ) srcDir in Module.make_dir currentDir (List.map (fun m -> Hier.append hier m) modules) ) else ( let (srcPath, srcFile, intfFile) = match file_entry with | Hier.FileEntry (path, file) -> (path, file, (Hier.ml_to_ext file Filetype.FileMLI)) | Hier.DirectoryEntry (path, file) -> (path, file, (Hier.ml_to_ext file Filetype.FileMLI)) | Hier.GeneratedFileEntry (path, file, generated) -> let src_file = path_basename file in let actual_src_path = Dist.get_build_exn (Dist.Target target.target_name) in let full_dest_file = actual_src_path generated in let intf_file = Hier.ml_to_ext full_dest_file Filetype.FileMLI in if not (Filesystem.exists full_dest_file) || ((Filesystem.getModificationTime full_dest_file) < (Filesystem.getModificationTime file)) then Generators.run (actual_src_path (chop_extension src_file)) file moduleName; (actual_src_path, full_dest_file, intf_file) in let modTime = Filesystem.getModificationTime srcFile in let hasInterface = Filesystem.exists intfFile in let intfModTime = Filesystem.getModificationTime intfFile in (* augment pp if needed with per-file dependencies *) let per_settings = find_extra_matching target (Hier.to_string hier) in let per_pp = let l = List.filter (fun x -> x.target_extra_pp <> None) per_settings in if(List.length l) > 0 then (List.hd l).target_extra_pp else None in let pp = match target.target_obits.target_pp,per_pp with | None,None -> Pp.none | None,Some preprocessor | Some _, Some preprocessor -> let perPP = get_target_pp bstate target per_pp in let extraDeps = List.concat (List.map (fun x -> x.target_extra_builddeps) per_settings) in Pp.append perPP (get_syntax_pp bstate preprocessor (List.map fst extraDeps)) | Some preprocessor,None -> (* FIXME: we should re-use the dependency DAG here, otherwise we might end up in the case * where the extra dependencies are depending not in the correct order *) let extraDeps = List.concat (List.map (fun x -> x.target_extra_builddeps) per_settings) in Pp.append targetPP (get_syntax_pp bstate preprocessor (List.map fst extraDeps)) in let full_path include_path name = match name.[0] with | '.' -> (fp_to_string include_path) ^ "/" ^ name | _ -> name in let stdlib = fp (get_ocaml_config_key "standard_library" bstate.bstate_config) in let get_ppx_ppxopt fpath meta libname = let includePath = Meta.getIncludeDir stdlib (fpath,meta) in let pkg = Meta.Pkg.find libname.Libname.subnames meta in let ppx = pkg.Meta.Pkg.ppx in let ppxopt = pkg.Meta.Pkg.ppxopt in (includePath, ppx, ppxopt) in let ppx = let target_deps = get_all_builddeps target in let dag = bstate.bstate_config.project_pkgdeps_dag in let deps_lists = list_filter_map (fun (l,_) -> let dag_dep = Analyze.Dependency l in if (Dag.existsNode dag_dep dag) then begin let children = Dag.getChildren_full dag dag_dep in let deps = list_filter_map (fun d -> match d with Analyze.Target _ -> None | Analyze.Dependency l -> Some l) children in let uniq_deps = list_uniq deps in Some (l :: uniq_deps) end else None ) target_deps in let ppx_list = List.map (fun l -> let (ppxs,ppxopts) = List.fold_left (fun (ppxs,ppxopts) d -> match (Metacache.find d.Libname.main_name) with | None -> (ppxs,ppxopts) | Some (fpath, meta) -> let (includePath, ppx, ppxopt) = get_ppx_ppxopt fpath meta d in let ppxs_ = match ppx with None -> ppxs | Some (_,s) -> (includePath,s,d) :: ppxs in let ppxopts_ = ppxopts @ (List.map (fun (_,s) -> let ppxargs = string_split ',' s in (includePath, ppxargs) ) ppxopt) in (ppxs_, ppxopts_) ) ([],[]) (List.rev l) in let ppxs = list_uniq ppxs in if (List.length ppxs) > 1 then failwith ("More than 1 ppx " ^ (String.concat ", " (List.map (fun (_,s,_) -> s) ppxs))); if (List.length ppxs) = 0 then [] else let (includePath,ppx_name,ppx_lib) = List.hd ppxs in List.iter (fun (_,ss) -> let res = (Libname.of_string (List.hd ss)) = ppx_lib in if not res then failwith ("Different ppx " ^ ppx_name ^ " <> " ^ (List.hd ss)) ) ppxopts; (full_path includePath ppx_name) :: (List.map (fun (includePath,args) -> String.concat " " (List.map (fun a -> full_path includePath a) (List.tl args))) ppxopts) ) deps_lists in let ppx_list = no_empty [] ppx_list in List.flatten (List.map (fun l -> ["-ppx"; String.concat " " l]) ppx_list) in verbose Debug " %s has mtime %f\n%!" moduleName modTime; if hasInterface then verbose Debug " %s has interface (mtime=%f)\n%!" moduleName intfModTime; let dopt = { dep_includes = file_search_paths hier; dep_pp = pp } in let allDeps = match runOcamldep dopt srcFile with | [] -> raise Module.DependencyNoOutput | ml::mli::_ -> list_uniq (ml @ mli) | x::_ -> x in verbose Debug " %s depends on %s\n%!" moduleName (String.concat "," allDeps); let (cwdDepsInDir, otherDeps) = List.partition (fun dep -> try let entry = Hier.get_file_entry (Hier.of_modname dep) (file_search_paths hier) in match entry with | Hier.DirectoryEntry (p,_) | Hier.FileEntry (p,_) | Hier.GeneratedFileEntry (p,_,_) -> List.mem p (file_search_paths hier) with Not_found -> false ) allDeps in verbose Debug " %s internally depends on %s\n%!" moduleName (String.concat "," (List.map Modname.to_string cwdDepsInDir)); let use_thread = if List.mem (Modname.wrap "Thread") otherDeps || List.mem (Modname.wrap "Condition") otherDeps || List.mem (Modname.wrap "Mutex") otherDeps then WithThread else NoThread in let cwdDeps = List.map (fun x -> maybe (Hier.make [x]) (fun z -> Hier.append z x) (Hier.parent hier)) cwdDepsInDir in (if List.mem hier cwdDeps then raise (Module.DependsItself hier) ); let intfDesc = if hasInterface then Some (Module.Intf.make intfModTime intfFile) else None in Module.make_file use_thread srcFile modTime (match file_entry with Hier.FileEntry _ -> SimpleModule | Hier.GeneratedFileEntry _ -> GeneratedModule) intfDesc pp ((target.target_obits.target_oflags @ (List.concat (List.map (fun x -> x.target_extra_oflags) (find_extra_matching target (Hier.to_string hier))))) @ ppx) cwdDeps otherDeps ) in module_desc_ty in let rec loop modname = if Hashtbl.mem modulesDeps modname then () else ( let mdesc = get_one modname in Hashtbl.add modulesDeps modname mdesc; (* TODO: don't query single modules at time, where ocamldep supports M modules. tricky with single file syntax's pragma. *) match mdesc with | Module.DescFile dfile -> List.iter loop dfile.Module.File.dep_cwd_modules | Module.DescDir ddir -> List.iter loop ddir.Module.Dir.modules ) in List.iter (fun m -> loop m) toplevelModules; modulesDeps (* prepare modules dependencies and various compilation state * that is going to be required for compilation and linking. *) let prepare_target_ bstate buildDir target toplevelModules = let autogenDir = Dist.get_build_exn Dist.Autogen in let buildDirP = buildDir fn "opt-p" in let buildDirD = buildDir fn "opt-d" in let cbits = target.target_cbits in let obits = target.target_obits in verbose Verbose "preparing compilation for %s\n%!" (Target.get_target_name target); let modulesDeps = get_modules_desc bstate target toplevelModules in (* create 2 dags per target * - stepsDag is a DAG of all the tasks to achieve the target (compilation only, not linking yet) * - filesDag is a DAG of all the files dependencies (C files & H files) **) let get_dags () = let filesDag = Dag.init () in let stepsDag = Dag.init () in let h = hashtbl_map (fun dep -> match dep with | Module.DescDir _ -> [] | Module.DescFile dfile -> dfile.Module.File.dep_cwd_modules ) modulesDeps in while Hashtbl.length h > 0 do let freeModules = Hashtbl.fold (fun k v acc -> if v = [] then k :: acc else acc) h [] in if freeModules = [] then raise (Module.DependenciesProblem (hashtbl_keys h)) else (); List.iter (fun m -> let mdep = Hashtbl.find modulesDeps m in let mStep = match mdep with | Module.DescFile f -> (* if it is a .mli only module ... *) if (Filetype.of_filepath f.Module.File.path) = Filetype.FileMLI then CompileInterface m else begin if Module.has_interface mdep then ( Dag.addEdge (CompileModule m) (CompileInterface m) stepsDag; ); CompileModule m end | Module.DescDir descdir -> let mStep = CompileDirectory m in List.iter (fun dirChild -> (*printf " %s depends %s" (string_of_compilation_step mStep) ((Compi *) let depChild = Hashtbl.find modulesDeps dirChild in let cStep = match depChild with | Module.DescFile f -> (* if it is a .mli only module ... *) if (Filetype.of_filepath f.Module.File.path) = Filetype.FileMLI then CompileInterface dirChild else CompileModule dirChild | Module.DescDir _ -> CompileDirectory dirChild in Dag.addEdge mStep cStep stepsDag ) descdir.Module.Dir.modules; mStep in Dag.addNode mStep stepsDag; Hashtbl.iter (fun k v -> if k <> m then ( if List.mem m v then ( let kdep = Hashtbl.find modulesDeps k in match kdep with | Module.DescFile _ -> if Module.has_interface kdep then ( Dag.addEdgesConnected [CompileModule k; CompileInterface k; mStep] stepsDag ) else Dag.addEdge (CompileModule k) mStep stepsDag | Module.DescDir _ -> Dag.addEdge (CompileDirectory k) mStep stepsDag ) ) ) h; ) freeModules; let roots = Dag.getRoots stepsDag in List.iter (fun r -> match r with | CompileModule _ | CompileDirectory _-> Dag.addEdge (LinkTarget target) r stepsDag; Dag.addEdge (CheckTarget target) (LinkTarget target) stepsDag; | _ -> () ) roots; hashtbl_modify_all (fun v -> List.filter (fun x -> not (List.mem x freeModules)) v) h; List.iter (Hashtbl.remove h) freeModules; done; (* just append each C sources as single node in the stepsDag *) if cbits.target_csources <> [] then ( let objDeps = runCCdep cbits.target_cdir cbits.target_csources in List.iter (fun cSource -> let (fps : filepath list) = try List.assoc (Filetype.replace_extension cSource Filetype.FileO) objDeps with _ -> failwith ("cannot find dependencies for " ^ fn_to_string cSource) in let cFile = cbits.target_cdir cSource in let hFiles = List.map (fun x -> Filetype.make_id (Filetype.FileH, x)) (List.filter (fun x -> Filetype.of_filepath x = Filetype.FileH) fps) in let oFile = buildDir (cSource <.> "o") in let cNode = Filetype.make_id (Filetype.FileC, cFile) in let oNode = Filetype.make_id (Filetype.FileO, oFile) in (* add C source information into the files DAG *) Dag.addEdge oNode cNode filesDag; Dag.addChildrenEdges oNode hFiles filesDag; (* add C source compilation task into the step DAG *) Dag.addNode (CompileC cSource) stepsDag ) cbits.target_csources; ); (stepsDag, filesDag) in let (dag, fdag) = get_dags () in if gconf.dump_dot then ( let dotDir = Dist.create_build Dist.Dot in let path = dotDir fn (Target.get_target_name target ^ ".dot") in let reducedDag = Dag.transitive_reduction dag in let dotContent = Dag.toDot string_of_compile_step (Target.get_target_name target) true reducedDag in Filesystem.writeFile path dotContent; let path = dotDir fn (Target.get_target_name target ^ ".files.dot") in let dotContent = Dag.toDot (fun fdep -> Filetype.to_string (Filetype.get_type fdep) ^ " " ^ fp_to_string (Filetype.get_path fdep)) (Target.get_target_name target) true fdag in Filesystem.writeFile path dotContent; ); let conf = bstate.bstate_config in let stdlib = fp (get_ocaml_config_key "standard_library" conf) in let depPkgs = Analyze.get_pkg_deps target conf in let (depsInternal,depsSystem) = List.partition (fun dep -> match Hashtbl.find conf.project_dep_data dep with | Internal -> true | _ -> false) depPkgs in let depIncPathInter = List.map (fun dep -> Dist.get_build_exn (Dist.Target (Name.Lib dep))) depsInternal in let depIncPathSystem = List.map (fun dep -> Meta.getIncludeDir stdlib (Metacache.get_from_cache dep)) depsSystem in let depIncludePaths = depIncPathInter @ depIncPathSystem in let depIncludePathsD = List.map (fun fp -> fp fn "opt-d") depIncPathInter @ depIncPathSystem in let depIncludePathsP = List.map (fun fp -> fp fn "opt-p") depIncPathInter @ depIncPathSystem in let depLinkingPaths = List.map (fun dep -> match Hashtbl.find conf.project_dep_data dep with | Internal -> Dist.get_build_exn (Dist.Target (Name.Lib dep)) | System -> Meta.getIncludeDir stdlib (Metacache.get_from_cache dep) ) depPkgs in let cdepsIncludePaths : filepath list = cbits.target_clibpaths @ List.concat (List.map (fun (cpkg,_) -> (Hashtbl.find bstate.bstate_config.project_cpkgs cpkg).cpkg_conf_includes) cbits.target_cpkgs) in let cCamlIncludePath = fp (Analyze.get_ocaml_config_key "standard_library" bstate.bstate_config) in { compilation_modules = modulesDeps ; compilation_csources = cbits.target_csources ; compilation_dag = dag ; compilation_pp = Pp.none ; compilation_filesdag = fdag ; compilation_builddir_c = buildDir ; compilation_builddir_ml = (fun m -> match m with | Normal -> buildDir | WithDebug -> buildDirD | WithProf -> buildDirP) ; compilation_include_paths = (fun m hier -> ((match m with | Normal -> buildDir | WithDebug -> buildDirD | WithProf -> buildDirP) Hier.to_dirpath hier) :: [autogenDir] @ (List.map (fun dir -> dir Hier.to_dirpath hier) obits.target_srcdir) @ (match m with | Normal -> depIncludePaths | WithDebug -> depIncludePathsD | WithProf -> depIncludePathsP)) ; compilation_linking_paths = [buildDir] @ depLinkingPaths ; compilation_linking_paths_p = [buildDirP;buildDir] @ depLinkingPaths ; compilation_linking_paths_d = [buildDirD;buildDir] @ depLinkingPaths ; compilation_c_include_paths = [cbits.target_cdir] @ cdepsIncludePaths @ [cCamlIncludePath; autogenDir] ; compilation_c_linking_paths = [buildDir] } let prepare_target bstate buildDir target toplevelModules = try prepare_target_ bstate buildDir target toplevelModules with exn -> verbose Verbose "Prepare.target : uncaught exception %s\n%!" (Printexc.to_string exn); raise exn obuild-obuild-v0.1.10/obuild/process.ml000066400000000000000000000062401327005302600177770ustar00rootroot00000000000000open Helper open Gconf open Ext.Compat type output = { buf : Buffer.t; fd : Unix.file_descr; mutable closed : bool; } let create_output fd = { buf = Buffer.create 1024; fd = fd; closed = false; } type t = { args : string list; (* command args *) pid : int; (* process PID *) time : float; (* Process starting time *) out : output; err : output; } (* create a new process with stdout and stderr redirected * and returns a new process_state *) let make args = let escape s = try let _ = String.index s ' ' in "\"" ^ s ^ "\"" with Not_found -> s in verbose DebugPlus " [CMD]: %s\n%!" (String.concat " " (List.map escape args)); let (r1,w1) = Unix.pipe () in let (r2,w2) = Unix.pipe () in let argv = Array.of_list args in let pid = Unix.create_process argv.(0) argv Unix.stdin w1 w2 in List.iter Unix.close [w1;w2]; { args = args; out = create_output r1; err = create_output r2; pid = pid; time = Unix.gettimeofday (); } type result = Success of string (* stdout *) * string (* stderr *) * float (* duration *) | Failure of string (* sterr *) type call = unit -> t (* process a list of processes until one finish. * The finishing 'signal' is when both stdout * and stderr are eofed. *) let wait processes = let is_finished (_, p) = p.err.closed && p.out.closed in let remove_from_list e list = List.filter (fun x -> x <> e) list in let process_loop () = let b = bytes_create 1024 in let live_processes = ref processes in let done_processes = ref None in let read_fds () = List.fold_left (fun acc (_, p) -> let res = if p.out.closed then acc else p.out.fd :: acc in if p.err.closed then res else p.err.fd :: res) [] !live_processes in let fds = ref (read_fds ()) in (* process until at least one process terminate *) while !done_processes = None do let (reads, _, _) = Unix.select !fds [] [] 2.0 in let check_fd out = if not out.closed && List.mem out.fd reads then let nb = Unix.read out.fd b 0 1024 in if nb > 0 then buffer_add_subbytes out.buf b 0 nb else (Unix.close out.fd; out.closed <- true; fds := read_fds ()) in List.iter (fun (task, p) -> check_fd p.out; check_fd p.err; if !done_processes = None && is_finished (task, p) then done_processes := Some (task, p) ) !live_processes; done; match !done_processes with | None -> assert false | Some finished -> (finished, remove_from_list finished !live_processes) in try let finished = List.find is_finished processes in (finished, remove_from_list finished processes) with Not_found -> process_loop () (* cleanup a process and return a Success|Failure value. *) let terminate (_, p) = let (_, pstat) = Unix.waitpid [] p.pid in match pstat with | Unix.WEXITED 0 -> Success (Buffer.contents p.out.buf, Buffer.contents p.err.buf, Unix.gettimeofday () -. p.time) | _ -> Failure (Buffer.contents p.err.buf) (* simple helper for a single process spawn|process|terminate *) let run args = let p = make args in let (p2, _) = wait [((), p)] in terminate p2 obuild-obuild-v0.1.10/obuild/prog.ml000066400000000000000000000076071327005302600173000ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext exception OCamlProgramError of string exception TarError of string exception PkgConfigError of string exception PkgConfigErrorNoVersion exception PkgConfigErrorUnexpectedOutput of string exception ProgramNotFound of string let get_cache prog names = let res = Gconf.get_env prog in match res with | Some p -> p | None -> try let syspath = Utils.get_system_paths () in let found = list_findmap (fun n -> let n = if Utils.isWindows then (n ^ ".exe") else n in if Filename.is_implicit n then (try let found_path = Utils.find_in_paths syspath (fn n) in Some (fp_to_string (found_path fn n)) with Utils.FileNotFoundInPaths _ -> None) else (if Filesystem.exists (fp n) then Some n else None) ) names in Gconf.set_env prog found; found with Not_found -> raise (ProgramNotFound prog) let getOcamlOpt () = get_cache "ocamlopt" ["ocamlopt.opt"; "ocamlopt"] let getOcamlC () = get_cache "ocamlc" ["ocamlc.opt"; "ocamlc"] let getOcamlDep () = get_cache "ocamldep" ["ocamldep.opt"; "ocamldep"] let getOcamlDoc () = get_cache "ocamldoc" ["ocamldoc.opt"; "ocamldoc"] let getOcamlYacc ()= get_cache "ocamlyacc" ["ocamlyacc"] let getOcamlLex () = get_cache "ocamllex" ["ocamllex.opt"; "ocamllex"] let getOcamlMklib () = get_cache "ocamlmklib" ["ocamlmklib"] let getCamlp4 () = get_cache "camlp4" ["camlp4"] let getCC () = get_cache "cc" ["gcc"] let getRanlib () = get_cache "ranlib" ["ranlib"] let getAR () = get_cache "ar" ["ar"] let getLD () = get_cache "ld" ["ld"] let getPkgConfig() = get_cache "pkg-config" ["pkg-config"] let getOcaml () = get_cache "ocaml" ["ocaml"] let getOcamlMktop () = get_cache "ocamlmktop" ["ocamlmktop"] let getAtdGen () = get_cache "atdgen" ["atdgen"; "atdgen.run"] let get_ocaml_version cfg = let ver = Hashtbl.find cfg "version" in match string_split ~limit:3 '.' ver with | [major;minor;other] -> (major,minor,other) | _ -> raise (OCamlProgramError ("ocaml return an unknown version " ^ ver)) let ocaml_config = ref None let getOcamlConfig () = match !ocaml_config with | None -> (match Process.run [ getOcamlOpt (); "-config" ] with | Process.Success (s,_,_) -> let lines = string_lines_noempty s in let h = Hashtbl.create 32 in List.iter (fun l -> let (k,v) = Utils.toKV l in Hashtbl.add h k (default "" v) ) lines; ocaml_config := Some h; h | Process.Failure err -> raise (OCamlProgramError ("ocamlopt cannot get config " ^ err))) | Some h -> h let getCamlp4Config () = match Process.run [ getCamlp4 (); "-where" ] with | Process.Success (s,_,_) -> let (l:_) = string_lines_noempty s in l | Process.Failure err -> raise (OCamlProgramError ("ocamlopt cannot get config " ^ err)) let runTar output dir = match Process.run [ "tar"; "czf"; output; dir ] with | Process.Success _ -> () | Process.Failure err -> raise (TarError err) let runPkgConfig typ name = match Process.run [ getPkgConfig (); typ; name ] with | Process.Success (s,_,_) -> s | Process.Failure err -> raise (PkgConfigError err) let runPkgConfigVersion name = let output = runPkgConfig "--version" name in match string_words_noempty output with | [ver] -> ver | [] -> raise PkgConfigErrorNoVersion | _ -> raise (PkgConfigErrorUnexpectedOutput ("version: " ^ output)) let runPkgConfigIncludes name = let output = runPkgConfig "--cflags" name in (* FIXME check if every items actually got -L as expected *) List.map (string_drop 2) (string_words_noempty output) let runPkgConfigLibs name = let output = runPkgConfig "--libs" name in (* FIXME check if every items actually got -l as expected *) List.map (string_drop 2) (string_words_noempty output) obuild-obuild-v0.1.10/obuild/project.ml000066400000000000000000000575411327005302600200010ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext open Printf open Target exception NoConfFile exception MultipleConfFiles exception InvalidConfFile of string exception MissingField of string exception UnknownDependencyName of string exception UnsupportedFutureVersion of int exception ModuleDoesntExist of target * Hier.t exception ModuleListEmpty of Libname.t exception FileDoesntExist of target * filename exception LicenseFileDoesntExist of filepath exception BlockSectionAsValue of string exception ExecutableWithNoMain of string exception UnknownStdlib of string exception UnknownExtraDepFormat of string exception UnknownFlag of string exception BadOcamlVersion of (string * Expr.t) exception LibraryNotFound of Libname.t exception ExecutableNotFound of string exception BenchNotFound of string exception TestNotFound of string exception ExampleNotFound of string type 'a optionHandling = Handled of 'a | NotHandled let raise_if_strict strict s = if strict then raise (InvalidConfFile s) else Printf.eprintf "config warning: %s\n" s let get_context_name ctx_name = function | [name] -> name | [] -> failwith (ctx_name ^ " need a name") | _ -> failwith (ctx_name ^ " has too many arguments, expecting just a name") let rec get_block (lvl: int) (lines: (int * string) list): ((int * string) list * (int * string) list) = match lines with | [] -> ([], []) | (clvl, line)::ls -> if lvl < clvl then let (b1, b2) = get_block lvl ls in ((clvl, line) :: b1, b2) else ([], lines) let rec process_chunk f acc (lines: (int*string) list) = match lines with | [] -> acc | (lvl, line)::ls -> let (cont,rem) = get_block lvl ls in let nacc = f acc line cont in process_chunk f nacc rem let do_block ty mempty parseM accu args cont = let name = get_context_name ty args in accu (process_chunk parseM (mempty name) cont) let do_block2 _ mempty parseM accu args cont = accu (process_chunk parseM (mempty args) cont) let parse_deps key_parse value = let parse_dependency w = let (d,c) = Expr.parse_builddep w in (key_parse d, c) in List.map parse_dependency (Utils.parseCSV value) let parse_extra_dep value = let vs = Utils.parseCSV value in List.map (fun v -> match string_words v with | [h1; "then"; h2] | [h1; "before"; h2] | [h1; "->"; h2] | [h1; h2] -> (Hier.of_string h1, Hier.of_string h2) | _ -> raise (UnknownExtraDepFormat v) ) vs let parse_filenames value = List.map fn (Utils.parseCSV value) let parse_stdlib value = match String.lowercase value with | "none" | "no" -> Stdlib_None | "standard" -> Stdlib_Standard | "core" -> Stdlib_Core | _ -> raise (UnknownStdlib value) let parse_runtime_bool _ = function | "true" | "True" -> BoolConst true | "false" | "False" -> BoolConst false | flag -> if string_startswith "$" flag then BoolVariable (string_drop 1 flag) else BoolVariable flag let parse_module_name value = let wrap_module_nice s = Hier.make [(Modname.wrap (String.capitalize s))] in List.map wrap_module_nice (Utils.parseCSV value) let parse_per strict (acc: target_extra) line cont = match Utils.toKV line with | (_, None) -> raise_if_strict strict ("no block in per"); acc | (k, Some v) -> let (value: string) = String.concat "\n" (v :: List.map snd cont) in match String.lowercase k with | "builddepends" | "builddeps" | "build-deps" -> { acc with target_extra_builddeps = parse_deps Libname.of_string value @ acc.target_extra_builddeps } | "oflags" -> { acc with target_extra_oflags = acc.target_extra_oflags @ string_words_noempty value } | "pp" -> { acc with target_extra_pp = Some (Pp.Type.of_string value) } | _ -> raise_if_strict strict ("unexpected item in : " ^ k); acc let parse_otarget t k value = match k with | "builddepends" | "builddeps" | "build-deps" -> Handled { t with target_builddeps = parse_deps Libname.of_string value @ t.target_builddeps } | "path" | "srcdir" | "src-dir" -> Handled { t with target_srcdir = List.map (fun p -> fp p) (Utils.parseCSV value) } | "preprocessor" | "pp" -> Handled { t with target_pp = Some (Pp.Type.of_string value) } | "extra-deps" -> Handled { t with target_extradeps = t.target_extradeps @ parse_extra_dep value } | "oflags" -> Handled { t with target_oflags = t.target_oflags @ string_words_noempty value } | "stdlib" -> Handled { t with target_stdlib = parse_stdlib value } | _ -> NotHandled let parse_ctarget t k value = match k with | "cdir" | "c-dir" -> Handled { t with target_cdir = fp value } | "csources" | "c-sources" -> Handled { t with target_csources = t.target_csources @ parse_filenames value } | "cflags" | "c-flags" | "ccopts" | "ccopt" | "c-opts" -> Handled { t with target_cflags = t.target_cflags @ string_words_noempty value } | "c-libpaths" -> Handled { t with target_clibpaths = t.target_clibpaths @ List.map fp (string_words_noempty value) } | "c-libs" -> Handled { t with target_clibs = t.target_clibs @ string_words_noempty value } | "c-pkgs" -> Handled { t with target_cpkgs = t.target_cpkgs @ parse_deps id value } | _ -> NotHandled let parse_target strict t k value = match k with | "buildable" -> { t with target_buildable = parse_runtime_bool "buildable" value } | "installable" -> { t with target_installable = parse_runtime_bool "installable" value } | k -> match parse_otarget t.target_obits k value with | Handled nobits -> { t with target_obits = nobits } | NotHandled -> match parse_ctarget t.target_cbits k value with | Handled ncbits -> { t with target_cbits = ncbits } | NotHandled -> raise_if_strict strict ("unexpected item in : " ^ k); t module Library = struct type t = { name : Libname.t; description : string; target : target; modules : Hier.t list; pack : bool; syntax : bool; subs : t list; } let make name = { name; description = ""; modules = []; pack = false; syntax = false; target = newTarget (Name.Lib name) Typ.Lib true true; subs = [] } let make_prefix libname subname = make (Libname.append libname subname) let make_from_string libname = make (Libname.of_string libname) let to_target obj = obj.target let rec to_targets lib = lib.target :: List.concat (List.map to_targets lib.subs) let rec flatten lib : t list = lib :: List.concat (List.map flatten lib.subs) let find libs name = try List.find (fun l -> l.name = name) (List.concat (List.map flatten libs)) with Not_found -> raise (LibraryNotFound name) let check_modules_not_empty lib = if lib.modules = [] then raise (ModuleListEmpty (lib.name)) let rec show add show_target section lib = add "\n"; add (sprintf "%slibrary %s\n" section (Libname.to_string lib.name)); let iStr = section ^ " " in add (sprintf "%smodules: %s\n" iStr (Utils.showList "," Hier.to_string lib.modules)); if lib.pack then add (sprintf "%spack: %b\n" iStr lib.pack); if lib.syntax then add (sprintf "%ssyntax: %b\n" iStr lib.syntax); if lib.pack then add (sprintf "%spack: %b\n" iStr lib.pack); show_target iStr lib.target; List.iter (fun sub -> show add show_target iStr sub) lib.subs let rec parse strict acc line cont = match Utils.toKV line with | (k, None) -> (match string_words_noempty k with | [] -> raise_if_strict strict ("unknown empty block in library"); acc | blockName :: args -> match String.lowercase blockName with | "sub" | "sublib" | "library" -> ( let doSub = do_block "library" (make_prefix acc.name) (parse strict) (fun obj -> { acc with subs = obj :: acc.subs}) in doSub args cont ) | "per" -> ( let t = acc.target in let doPer = do_block2 "per" newTargetExtra (parse_per strict) (fun obj -> { acc with target = { t with target_extras = obj :: t.target_extras } }) in doPer args cont ) | _ -> raise_if_strict strict ("unexpected block name in library: " ^ blockName); acc ) | (k, Some v) -> let (value: string) = String.concat "\n" (v :: List.map snd cont) in (match String.lowercase k with | "modules" -> { acc with modules = parse_module_name value @ acc.modules } | "pack" -> { acc with pack = user_bool_of_string "pack" value } | "syntax" -> { acc with syntax = user_bool_of_string "syntax" value } | "description" -> { acc with description = value } | "sub" | "sublib" | "library" -> raise (BlockSectionAsValue k) | k -> { acc with target = parse_target strict acc.target k value } ) end module Executable = struct type t = { name : string; main : filename; target : target; } let make name = { name; main = emptyFn; target = newTarget (Name.Exe name) Typ.Exe true true } let to_target obj = obj.target let parse_common strict sectionName setMain setTarget myTarget other acc line cont = match Utils.toKV line with | (k, None) -> (match string_words_noempty k with | [] -> raise_if_strict strict ("unknown empty block in " ^ sectionName ^ " " ^ k); acc | blockName :: args -> ( match String.lowercase blockName with | "per" -> ( let t = myTarget in let doPer = do_block2 "per" (newTargetExtra) (parse_per strict) (fun obj -> setTarget acc { t with target_extras = obj :: t.target_extras }) in doPer args cont ) | _ -> raise_if_strict strict ("unexpected block name in library: " ^ blockName); acc ) ) | (k, Some v) -> let (value: string) = String.concat "\n" (v :: List.map snd cont) in (match String.lowercase k with | "main" | "mainis" | "main-is" -> setMain acc (fn value) | k -> try let f = List.assoc k other in f acc value with Not_found -> setTarget acc (parse_target strict myTarget k value) ) let parse strict obj = parse_common strict "executable" (fun acc main -> { acc with main = main }) (fun acc target -> { acc with target = target }) obj.target [] obj let find exes name = try List.find (fun e -> e.name = name) exes with Not_found -> raise (ExecutableNotFound name) end module Test = struct type test_type = ExitCode type t = { name : string; main : filename; target : target; rundir : filepath option; runopt : string list; type_ : test_type; } let make name = { name; main = emptyFn; target = newTarget (Name.Test name) Typ.Test (Gconf.get_target_option "build-tests") false; rundir = None; runopt = []; type_ = ExitCode; } let to_target obj = obj.target let parse strict obj = Executable.parse_common strict "test" (fun acc main -> { acc with main = main }) (fun acc target -> { acc with target = target }) obj.target [ ("rundir", (fun acc v -> { acc with rundir = Some (fp v) })) ; ("runopt", (fun acc v -> { acc with runopt = acc.runopt @ string_words v })) ] obj let find tests name = try List.find (fun b -> b.name = name) tests with Not_found -> raise (TestNotFound name) end module Bench = struct type t = { name : string; main : filename; target : target; (* TODO add bench type *) } let to_target obj = obj.target let find benchs name = try List.find (fun b -> b.name = name) benchs with Not_found -> raise (BenchNotFound name) end (* an example is an executable that doesn't get installed. * or maybe install in a documentation directory *) module Example = struct type t = { name : string; main : filename; target : target; } let to_target obj = obj.target let make name = { name = name; main = emptyFn; target = newTarget (Name.Example name) Typ.Test (Gconf.get_target_option "build-examples") false; } let parse strict obj = Executable.parse_common strict "example" (fun acc main -> { acc with main = main }) (fun acc target -> { acc with target = target }) obj.target [] obj let find examples name = try List.find (fun b -> b.name = name) examples with Not_found -> raise (ExampleNotFound name) end module Flag = struct type t = { name : string; description : string; default : bool option; } let make args = { name = get_context_name "flag" args; description = ""; default = None; } let parse strict acc line cont = match Utils.toKV line with | (k, None) -> raise_if_strict strict ("unexpected item in flag " ^ k); acc | (k, Some v) -> let (value: string) = String.concat "\n" (v :: List.map snd cont) in (match String.lowercase k with | "description" -> { acc with description = value } | "default" -> { acc with default = Some (user_bool_of_string "flag default" value) } | k -> (raise_if_strict strict ("unexpected item in flag : " ^ k); acc) ) let find flags name = try Some (List.find (fun fl -> fl.name = name) flags) with Not_found -> None end type t = { name : string; version : string; synopsis : string; description : string; license : string; license_file: filepath option; authors : string list; obuild_ver : int; ocaml_ver : Expr.t option; homepage : string; flags : Flag.t list; libs : Library.t list; exes : Executable.t list; tests : Test.t list; benchs : Bench.t list; examples : Example.t list; extra_srcs : filepath list; extra_tools : filename list; configure_script : filepath option; ocaml_extra_args : string list option; } let make = { name = ""; version = ""; synopsis = ""; description = ""; license = ""; license_file= None; authors = []; obuild_ver = 0; ocaml_ver = None; homepage = ""; extra_tools = []; flags = []; libs = []; exes = []; tests = []; benchs = []; examples = []; extra_srcs = []; configure_script = None; ocaml_extra_args = None; } let findPath () = let ents = Array.to_list (Sys.readdir ".") in match List.find_all (fun ent -> not (string_startswith "." ent) && string_endswith ".obuild" ent) ents with | [] -> raise NoConfFile | [x] -> fp x | _ -> raise MultipleConfFiles let digest () = let path = findPath () in Digest.to_hex (Digest.file (fp_to_string path)) let parse strict lines = let parse_library acc = do_block "library" Library.make_from_string (Library.parse strict) (fun obj -> { acc with libs = obj :: acc.libs }) in let parse_executable acc = do_block "executable" Executable.make (Executable.parse strict) (fun obj -> { acc with exes = obj :: acc.exes }) in let parse_test acc = do_block "test" Test.make (Test.parse strict) (fun obj -> { acc with tests = obj :: acc.tests }) in let parse_example acc = do_block "example" Example.make (Example.parse strict) (fun obj -> { acc with examples = obj :: acc.examples }) in let parse_flag acc args cont = let flag = process_chunk (Flag.parse strict) (Flag.make args) cont in { acc with flags = flag :: acc.flags } in (************* root parsing *******************************) let parse_root acc (line: string) (cont: (int*string) list) = match Utils.toKV line with | (k, None) -> (match string_words_noempty k with | [] -> raise_if_strict strict ("unknown empty block"); acc | blockName :: args -> match String.lowercase blockName with | "executable" -> parse_executable acc args cont | "library" -> parse_library acc args cont | "flag" -> parse_flag acc args cont | "test" -> parse_test acc args cont | "bench" -> raise_if_strict strict ("unimplemented section: " ^ blockName); acc | "example" -> parse_example acc args cont | _ -> raise_if_strict strict ("unknown block name: " ^ blockName); acc ) | (k, Some v) -> ( let (value: string) = String.concat "\n" (v :: List.map snd cont) in match String.lowercase k with | "name" -> { acc with name = value } | "version" -> { acc with version = value } | "synopsis" -> { acc with synopsis = value } | "description" -> { acc with description = value } | "license" | "licence" -> { acc with license = value } | "license-file" | "licence-file" -> { acc with license_file = Some (fp value) } | "homepage" -> { acc with homepage = value } | "tools" -> { acc with extra_tools = List.map fn (string_words_noempty value) @ acc.extra_tools } | "authors" -> { acc with authors = Utils.parseCSV value } | "author" -> { acc with authors = [value] } | "extra-srcs" -> { acc with extra_srcs = List.map fp (Utils.parseCSV value) @ acc.extra_srcs } | "obuild-ver" -> { acc with obuild_ver = user_int_of_string "obuild-ver" value } | "ocamlversion" | "ocaml-version" -> { acc with ocaml_ver = Expr.parse "ocaml-version" value } | "configure-script" -> { acc with configure_script = Some (fp value) } | "ocaml-extra-args" | "ocamlextraargs" -> let v = string_words_noempty value in Gconf.gconf.Gconf.ocaml_extra_args <- v; { acc with ocaml_extra_args = Some v } (* for better error reporting *) | "executable" | "library" | "test" | "bench" | "example" -> raise (BlockSectionAsValue k) | k -> raise_if_strict strict ("unknown key: " ^ k); acc ) in process_chunk parse_root make lines let check proj = (if proj.name = "" then raise (MissingField "name")); (if proj.version = "" then raise (MissingField "version")); (if proj.obuild_ver = 0 then raise (MissingField "obuild-ver")); (if proj.obuild_ver > 1 then raise (UnsupportedFutureVersion proj.obuild_ver)); let check_files_exists target names = let srcdir = target.target_obits.target_srcdir in List.iter (fun n -> ignore(Utils.find_in_paths srcdir n)) names in let check_modules_exists target modules = let srcdir = target.target_obits.target_srcdir in List.iter (fun m -> try ignore(Hier.get_file_entry m srcdir) with Not_found -> raise (ModuleDoesntExist (target, m)) ) modules in maybe_unit (fun x -> if not (Filesystem.exists x) then raise (LicenseFileDoesntExist x)) proj.license_file; maybe_unit (fun x -> let ocaml_ver = Hashtbl.find (Prog.getOcamlConfig ()) "version" in if not (Expr.eval ocaml_ver x) then raise (BadOcamlVersion (ocaml_ver,x))) proj.ocaml_ver; (* check sublibs in libs *) List.iter (fun rootlib -> Library.check_modules_not_empty rootlib; let sublibs = Library.flatten rootlib in List.iter (fun lib -> Library.check_modules_not_empty lib; check_modules_exists lib.Library.target lib.Library.modules) sublibs ) proj.libs; List.iter (fun exe -> if fn_to_string exe.Executable.main = "" then raise (ExecutableWithNoMain exe.Executable.name); check_files_exists exe.Executable.target [exe.Executable.main] ) proj.exes; () let read strict = let countSpacesAndTrim s = let len = String.length s in let p = ref 0 in while !p < len && s.[!p] = ' ' do p := !p + 1 done; if !p = len then None else (if s.[!p] = '#' then None else Some (!p, string_drop !p s)) in let path = findPath () in let lines = Utils.read_file_with (fun s -> countSpacesAndTrim s) (fp_to_string path) in let proj = parse strict lines in check proj; proj let write file proj = Utils.generateFile file (fun add -> let add_string k s = if s <> "" then add (sprintf "%s: %s\n" k s) in add (sprintf "name: %s\n" proj.name); add (sprintf "version: %s\n" proj.version); add_string "synopsis" proj.synopsis; add_string "description" proj.description; add_string "license" proj.license; add_string "homepage" proj.homepage; maybe () (fun x -> add_string "license-file" (fp_to_string x)) proj.license_file; add_string "authors" (Utils.showList ", " id proj.authors); add (sprintf "obuild-ver: %d\n" proj.obuild_ver); maybe () (fun x -> add_string "ocaml-version" (Expr.to_string x)) proj.ocaml_ver; maybe () (fun x -> add_string "ocaml-extra-args" (String.concat " " x)) proj.ocaml_extra_args; let show_target iStr target = let obits = target.target_obits in let cbits = target.target_cbits in add (sprintf "%ssrc-dir: %s\n" iStr (String.concat "," (List.map fp_to_string obits.target_srcdir))); add_string (iStr ^ "build-deps") (Utils.showList ", " (fun (l,_) -> Libname.to_string l) obits.target_builddeps); add_string (iStr ^ "oflags") (Utils.showList " " id obits.target_oflags); add_string (iStr ^ "pp") (maybe "" (fun ppty -> Pp.Type.to_string ppty) obits.target_pp); add (sprintf "%sc-dir: %s\n" iStr (fp_to_string cbits.target_cdir)); add_string (iStr ^ "c-sources") (Utils.showList ", " fn_to_string cbits.target_csources); add_string (iStr ^ "c-flags") (Utils.showList " " id cbits.target_cflags); add_string (iStr ^ "c-libs") (Utils.showList "," id cbits.target_clibs); add_string (iStr ^ "c-libpaths") (Utils.showList "," fp_to_string cbits.target_clibpaths); add_string (iStr ^ "c-pkgs") (Utils.showList ", " (fun (l,_) -> l) cbits.target_cpkgs); in List.iter (Library.show add show_target "") proj.libs; List.iter (fun exe -> add "\n"; add (sprintf "executable %s\n" exe.Executable.name); add (sprintf " main: %s\n" (fn_to_string exe.Executable.main)); show_target " " exe.Executable.target; () ) proj.exes; ) let get_all_targets projFile = List.concat (List.map Library.to_targets projFile.libs) @ List.map Executable.to_target projFile.exes @ List.map Test.to_target projFile.tests @ List.map Bench.to_target projFile.benchs @ List.map Example.to_target projFile.examples let get_all_targets_filter projFile f = List.filter (fun target -> f target) (get_all_targets projFile) let get_val_const_or_var user_flags = function | BoolConst t -> t | BoolVariable v -> try List.assoc v user_flags with Not_found -> raise (UnknownFlag v) let get_all_buildable_targets proj_file user_flags = get_all_targets_filter proj_file (fun target -> get_val_const_or_var user_flags target.target_buildable) let get_all_installable_targets proj_file user_flags = get_all_targets_filter proj_file (fun target -> let install = get_val_const_or_var user_flags target.target_installable in let build = get_val_const_or_var user_flags target.target_buildable in Printf.printf "target %s install %b build %b\n" (Target.Name.to_string target.target_name) install build; install) let find_lib proj_file name = Library.find proj_file.libs name let find_exe proj_file name = Executable.find proj_file.exes name let find_test proj_file name = Test.find proj_file.tests name let find_bench proj_file name = Bench.find proj_file.benchs name let find_example proj_file name = Example.find proj_file.examples name let find_flag name proj_file = Flag.find proj_file.flags name obuild-obuild-v0.1.10/obuild/scheduler.ml000066400000000000000000000111561327005302600203010ustar00rootroot00000000000000type call = unit -> Process.t (* this is used to control the scheduler behavior * from the idle function *) type 'a t = Terminate | WaitingTask | AddProcess of ('a * Process.t) | AddTask of ('a * (call list list)) | Retry | FinishTask of 'a let to_string = function | Terminate -> "terminate" | WaitingTask -> "waiting-task" | AddProcess (_,_) -> "add-process" | AddTask (_,_) -> "add-task" | Retry -> "retry" | FinishTask _ -> "finish-task" type 'a task_group = { mutable completion : int; mutable next : ('a * call) list list; } type stats = { mutable max_runqueue : int; mutable nb_processes : int; } type 'a state = { mutable runqueue : ('a * Process.t) list; mutable waitqueue : ('a * call) list; mutable terminate : bool; mutable waiting_task : bool; mutable tasks : ('a * 'a task_group) list; } (* wait until a process finish. *) let wait_process state = let (proc_done, processes) = Process.wait state.runqueue in let (task_done,_) = proc_done in let finished_task = try let tg = List.assoc task_done state.tasks in tg.completion <- tg.completion - 1; if tg.completion = 0 then ( match tg.next with | [] -> state.tasks <- List.filter (fun (t,_) -> t <> task_done) state.tasks; true | g :: gs -> tg.completion <- List.length g; tg.next <- gs; state.waitqueue <- g @ state.waitqueue; false ) else false with Not_found -> true in state.runqueue <- processes; (proc_done, finished_task) let rec idle_loop idle_fun on_task_finish_fun state = match idle_fun () with | Retry -> idle_loop idle_fun on_task_finish_fun state | AddProcess p -> state.runqueue <- p :: state.runqueue | WaitingTask -> state.waiting_task <- true | Terminate -> state.terminate <- true | FinishTask t -> on_task_finish_fun t; (* retry *) idle_loop idle_fun on_task_finish_fun state | AddTask (t,ps) -> (match List.map (List.map (fun p -> (t, p))) ps with | [] -> failwith "internal error: empty task added to the scheduler" | first::pss -> let tg = { completion = List.length first; next = pss } in state.tasks <- (t,tg) :: state.tasks; state.waitqueue <- first @ state.waitqueue; ) (* when the scheduler has some room, we get the next task from * taskdep and either start a process or call retry. * * Retry is returned when no process need to be spawned for the next task * since the dependencies have not changed and thus the cache still have * valid target file. Instead of returning retry, we could just go get * the next task ourself. *) let schedule_idle taskdep dispatch_fun () = if Taskdep.is_complete taskdep then Terminate else match Taskdep.get_next taskdep with | None -> WaitingTask | Some task -> dispatch_fun task (* this is a simple one thread loop to schedule * multiple tasks (forked) until they terminate * * the idle_fun function is called when there's capacity in the runqueue for * another task. * * the finish function is called when a subtask of the task has finished. * if all the subtasks in the task are done then the second value is set * to true. **) let schedule j taskdep dispatch_fun finish_fun = let st = { runqueue = []; waitqueue = []; terminate = false; waiting_task = false; tasks = []; } in let on_task_finish task = Taskdep.mark_done taskdep task in let stats = { max_runqueue = 0; nb_processes = 0 } in let pick_process (task, process) remaining_processes = stats.nb_processes <- stats.nb_processes + 1; st.runqueue <- (task,process ()) :: st.runqueue; st.waitqueue <- remaining_processes in let set_max () = let m = List.length st.runqueue in if stats.max_runqueue < m then stats.max_runqueue <- m in (* add more bulletproofing to prevent busy looping for no reason * if user of this api is not behaving properly *) while not st.terminate || st.runqueue <> [] || st.waitqueue <> [] do while not st.terminate && not st.waiting_task && List.length st.runqueue < j do match st.waitqueue with | [] -> idle_loop (schedule_idle taskdep dispatch_fun) on_task_finish st | (t,p)::procs -> pick_process (t,p) procs done; set_max (); if List.length st.runqueue > 0 then let (proc_done, finished_task) = wait_process st in st.waiting_task <- false; finish_fun proc_done finished_task else assert (st.terminate) done; stats obuild-obuild-v0.1.10/obuild/target.ml000066400000000000000000000126341327005302600176130ustar00rootroot00000000000000open Ext.Filepath open Ext.Fugue open Types open Dependencies module Typ = struct type t = Lib | Exe | Test | Bench let is_lib t = t = Lib end exception TargetNameNoType of string exception TargetUnknownType of string * string exception TargetNotRecognized of string module Name = struct type t = Lib of Libname.t | Exe of string | Test of string | Bench of string | Example of string let to_string = function | Exe e -> "exe-" ^ e | Bench e -> "bench-" ^ e | Test e -> "test-" ^ e | Example e -> "example-" ^ e | Lib l -> "lib-" ^ Libname.to_string l let of_string name = match string_split ~limit:2 '-' name with | ["exe"; n] -> Exe n | ["lib"; n] -> Lib (Libname.of_string n) | ["test"; n] -> Test n | ["bench"; n] -> Bench n | ["example"; n] -> Example n | [prefix; n] -> raise (TargetUnknownType (prefix, n)) | [_] -> raise (TargetNameNoType name) | _ -> raise (TargetNotRecognized name) let to_dirname = function | Exe e | Bench e | Test e | Example e -> fn e | Lib l -> fn ("lib-" ^ Libname.to_string l) let get_clibname = function | Exe e -> "stubs_" ^ e | Bench e -> "stubs_" ^ e | Test e -> "stubs_" ^ e | Example e -> "stubs_" ^ e | Lib l -> "stubs_" ^ list_last (Libname.to_string_nodes l) (* get the core name of the final object representing the object * for an executable/test/bench it will be the name of the executable apart from the extension * for a test it will be the name of the library created (.cmxa/.cma) apart from the extension *) let get_dest_name = function | Exe e -> e | Bench e -> "bench-" ^ e | Test e -> "test-" ^ e | Example e -> "example-" ^ e | Lib l -> String.concat "_" (Libname.to_string_nodes l) end type target_stdlib = Stdlib_None | Stdlib_Standard | Stdlib_Core type runtime_bool = BoolConst of bool | BoolVariable of string let runtime_def v = BoolConst v type target_cbits = { target_cdir : filepath ; target_csources : filename list ; target_cflags : string list (* CFLAGS *) ; target_clibs : string list ; target_clibpaths : filepath list ; target_cpkgs : cdependency list (* pkg-config name *) } type target_obits = { target_srcdir : filepath list; target_builddeps : dependency list; target_oflags : string list; target_pp : Pp.Type.t option; target_extradeps : (Hier.t * Hier.t) list; target_stdlib : target_stdlib; } type target_extra = { target_extra_objects : string list; (* targets of those extra settings *) target_extra_builddeps : dependency list; target_extra_oflags : string list; target_extra_cflags : string list; target_extra_pp : Pp.Type.t option; } type target = { target_name : Name.t ; target_type : Typ.t ; target_cbits : target_cbits ; target_obits : target_obits ; target_extras : target_extra list ; target_buildable : runtime_bool ; target_installable : runtime_bool } let newTargetCbits = { target_cdir = currentDir ; target_csources = [] ; target_cflags = [] ; target_clibs = [] ; target_clibpaths = [] ; target_cpkgs = [] } let newTargetObits = { target_oflags = []; target_builddeps = []; target_pp = None; target_srcdir = [currentDir]; target_extradeps = []; target_stdlib = Stdlib_Standard; } let newTarget n ty buildable installable = { target_name = n ; target_buildable = runtime_def buildable ; target_installable = runtime_def installable ; target_type = ty ; target_extras = [] ; target_cbits = newTargetCbits ; target_obits = newTargetObits } let newTargetExtra objs = { target_extra_objects = objs; target_extra_builddeps = []; target_extra_oflags = []; target_extra_cflags = []; target_extra_pp = None; } let get_target_name target = Name.to_string target.target_name let get_target_dest_name target = Name.get_dest_name target.target_name let get_target_clibname target = Name.get_clibname target.target_name let is_lib target = Typ.is_lib (target.target_type) let get_ocaml_compiled_types target = let (nat,byte) = if is_lib target then (Gconf.get_target_option "library-native", Gconf.get_target_option "library-bytecode") else (Gconf.get_target_option "executable-native", Gconf.get_target_option "executable-bytecode") in (if nat then [Native] else []) @ (if byte then [ByteCode] else []) let get_debug_profile target = if is_lib target then (Gconf.get_target_option "library-debugging", Gconf.get_target_option "library-profiling") else (Gconf.get_target_option "executable-debugging", Gconf.get_target_option "executable-profiling") let get_compilation_opts target = let (debug, prof) = get_debug_profile target in Normal :: (if debug then [WithDebug] else []) @ (if prof then [WithProf] else []) let get_all_builddeps target = let targetWideDeps = target.target_obits.target_builddeps in let fileSpecificDeps = List.map (fun extra -> extra.target_extra_builddeps) target.target_extras in targetWideDeps @ List.concat fileSpecificDeps let find_extra_matching target s = List.filter (fun extra -> List.mem s extra.target_extra_objects) target.target_extras obuild-obuild-v0.1.10/obuild/taskdep.ml000066400000000000000000000046521327005302600177610ustar00rootroot00000000000000open Printf open Ext.Fugue type direction = FromChildren | FromParent (* this is a simple task dependency 'scheduler' *) (* TODO Set *) type 'a t = { dag : 'a Dag.t; nb_steps : int; steps_done : ('a, unit) Hashtbl.t; direction : direction; mutable current_step : int; mutable next_tasks : 'a list; } (* init a new taskdep from a dag *) let init_with dag direction nodes = { dag = dag; nb_steps = Dag.length dag; current_step = 1; direction = direction; steps_done = Hashtbl.create 16; next_tasks = nodes; } let init ?(direction=FromChildren) dag = init_with dag direction (if direction = FromChildren then Dag.getLeaves dag else Dag.getRoots dag) let next_index taskdep = let c = taskdep.current_step in taskdep.current_step <- taskdep.current_step + 1; c (* get next task from the task dependency, and removes it from the next list *) let get_next taskdep = let nexts = taskdep.next_tasks in match nexts with | [] -> None | task::xs -> taskdep.next_tasks <- xs; Some (next_index taskdep, task) let mark_done taskdep step = Hashtbl.add taskdep.steps_done step (); (* check if any parents is now free to complete *) let parents = if taskdep.direction = FromChildren then Dag.getParents taskdep.dag step else Dag.getChildren taskdep.dag step in List.iter (fun parent -> let children = if taskdep.direction = FromChildren then Dag.getChildren taskdep.dag parent else Dag.getParents taskdep.dag parent in let allDone = List.for_all (fun child -> Hashtbl.mem taskdep.steps_done child) children in if allDone && not (List.mem parent taskdep.next_tasks) then taskdep.next_tasks <- taskdep.next_tasks @ [parent] ) parents let is_complete taskdep = Hashtbl.length taskdep.steps_done = taskdep.nb_steps let linearize dag direction nodes = let l = ref [] in let visited = Hashtbl.create 16 in let rec visit n = if not (Hashtbl.mem visited n) then ( Hashtbl.add visited n (); List.iter visit ((if direction = FromParent then Dag.getChildren else Dag.getParents) dag n); l := n :: !l; ) in List.iter visit nodes; !l let dump a_to_string taskdep = printf "tasks steps done: [%s]\n" (String.concat "," (List.map a_to_string (hashtbl_keys taskdep.steps_done))); printf "tasks next: [%s]\n" (String.concat "," (List.map a_to_string taskdep.next_tasks)) obuild-obuild-v0.1.10/obuild/types.ml000066400000000000000000000004131327005302600174610ustar00rootroot00000000000000type ocaml_compilation_option = Normal | WithDebug | WithProf type ocaml_compiled_type = ByteCode | Native type ocaml_compilation_mode = Interface | Compiled of ocaml_compiled_type let extDP = function | Normal -> "" | WithDebug -> ".d" | WithProf -> ".p" obuild-obuild-v0.1.10/obuild/utils.ml000066400000000000000000000060101327005302600174540ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext open Types let read_file_with f filename = let lines = ref [] in let chan = open_in filename in try while true; do let z = f (input_line chan) in match z with | None -> () | Some z' -> lines := z' :: !lines done; [] with End_of_file -> close_in chan; List.rev !lines let toKV line = match string_split ~limit:2 ':' line with | [k] -> (string_stripSpaces k, None) | [k;v] -> (string_stripSpaces k, Some (string_stripSpaces v)) | _ -> assert false let toKVeq line = match string_split ~limit:2 '=' line with | [k] -> (string_stripSpaces k, None) | [k;v] -> (string_stripSpaces k, Some (string_stripSpaces v)) | _ -> assert false let parseCSV value = List.filter (fun s -> (String.length s) > 0) (List.map string_stripSpaces (string_split ',' value)) let to_include_path_options paths = let ss = ref StringSet.empty in List.concat $ list_filter_map (fun p -> let ps = fp_to_string p in if (ps = "") || (StringSet.mem ps !ss) || not (Filesystem.exists p) then None else ( ss := StringSet.add ps !ss; Some ["-I"; ps] )) paths let showList sep f l = String.concat sep (List.map f l) let isWindows = Sys.os_type = "Win32" let to_exe_name mode build name = let ext = extDP mode in let ext2 = match build with | ByteCode -> ".byte" | Native -> if (Gconf.get_target_option "executable-as-obj") then ".o" else "" in fn (name ^ ext ^ ext2 ^ (if isWindows then ".exe" else "")) exception FileNotFoundInPaths of (filepath list * filename) exception FilesNotFoundInPaths of (filepath list * filepath list) let get_system_paths () = let sep = if isWindows then ';' else ':' in try List.map fp (string_split sep (Sys.getenv "PATH")) with Not_found -> List.map fp ["/usr/bin"; "/usr/local/bin"] let find_in_paths paths name = try List.find (fun p -> Filesystem.exists (p name)) paths with Not_found -> raise (FileNotFoundInPaths (paths, name)) let find_choice_in_paths paths names = try List.find (fun p -> try let _ = List.find (fun n -> Filesystem.exists (n p)) names in true with Not_found -> false ) paths with Not_found -> raise (FilesNotFoundInPaths (paths, (List.map (fun n -> n (List.hd paths)) names))) let exist_choice_in_paths paths names = try let _ = find_choice_in_paths paths names in true with FilesNotFoundInPaths _ -> false let find_in_system_path name = find_in_paths (get_system_paths ()) name let wrap_exn print fname f = try f () with exn -> print "%s: %s\n%!" fname (Printexc.to_string exn); raise exn let generateFile file f = let buffer = Buffer.create 1024 in f (Buffer.add_string buffer); Filesystem.writeFile file (Buffer.contents buffer) obuild-obuild-v0.1.10/opam000066400000000000000000000003751327005302600153730ustar00rootroot00000000000000opam-version: "1.2" homepage: "https://github.com/ocaml-obuild/obuild" bug-reports: "https://github.com/ocaml-obuild/obuild/issues" dev-repo: "https://github.com/ocaml-obuild/obuild.git" maintainer: "jmaloberti@gmail.com" build: [ ["./bootstrap"] ] obuild-obuild-v0.1.10/src/000077500000000000000000000000001327005302600152765ustar00rootroot00000000000000obuild-obuild-v0.1.10/src/doc.ml000066400000000000000000000006121327005302600163740ustar00rootroot00000000000000open Ext.Fugue open Obuild exception DocumentationBuildingFailed of string let runOcamldoc pp = let args = [ Prog.getOcamlDoc (); "-html" ] @ (maybe [] (fun s -> ["-pp"; s ]) pp) @ [] in match Process.run args with | Process.Failure er -> raise (DocumentationBuildingFailed er) | Process.Success (_,_,_) -> () let run projFile = () obuild-obuild-v0.1.10/src/help.ml000066400000000000000000000021661327005302600165650ustar00rootroot00000000000000 let helpConfigure = [ "Configure --- Prepare to build the package" ; "" ; "Configure verify that the environment is able to compile the project" ; "and this is where the user can tell obuild options to build" ; "" ; "System settings and user settings are cached, to provide faster" ; "access for building task" ] let helpClean = [ "Clean --- Cleanup after obuild" ; "" ; "Remove all by-product of compilation (.cmx, .cmi, .cmo, etc)" ; "and remove the dist directory." ] let helpBuild = [ "Build --- Build every buildable bits" ; "" ; "Build all your different targets (library, executable," ; "tests, benchmarks, example) that are marked as buildable." ] let helpSdist = [ "Sdist --- Create a source distribution file (.tar.gz)" ; "" ; "generate a source distribution file .tar.gz that contains" ; "all the necessary bits to distribute to someone else" ; "and being able to build and install the package" ] let helpMessages = [ "clean", helpClean ; "configure", helpConfigure ; "build", helpBuild ; "sdist", helpSdist ] obuild-obuild-v0.1.10/src/init.ml000066400000000000000000000075121327005302600166000ustar00rootroot00000000000000open Printf open Ext.Fugue open Ext.Filepath open Ext open Obuild.Helper open Obuild.Target open Obuild.Project open Obuild exception ProjectAlreadyExists exception CannotRunNotInteractive exception AbortedByUser let rec ask v x = printf "%s\n> %!" x; let r = try read_line () with End_of_file -> raise AbortedByUser in match v r with | None -> r | Some vp -> printf "error: %s\n" vp; ask v x let rec ask_many v x = let r = ask v x in if r = "" then [] else r :: ask_many v x let run () = (* check if a project file already exists and that we run in a interactive windows *) (try let _ = Project.findPath () in raise ProjectAlreadyExists with Project.NoConfFile -> ()); if not (Unix.isatty Unix.stdout) then (raise CannotRunNotInteractive); printf " %swelcome to the obuild wizard%s\n" (color_green ()) (color_white()); printf " ============================\n"; let expecting_output l s = if List.mem s l then None else Some (sprintf "expecting one of the following: %s" (Utils.showList ", " (fun s -> "\"" ^ s ^ "\"") l)) in (* strip [ext] from the the end of [s] only if it's there *) let strip_ext s ~ext = try let l = String.length s in let ext_l = String.length ext in if (String.sub s (l-ext_l) ext_l) = ext then String.sub s 0 (l-ext_l) else s with _ -> s (* in case out of bounds above *) in let invalid ~x = function | true -> None | false -> Some ("invalid " ^ x) in let valid_name n = invalid ~x:"name" (string_all char_is_alphanum n) in let valid_fp _ = None in (* FIXME *) let valid_fn n = invalid ~x:"filename" (Filepath.valid_fn n) in let valid_modname n = invalid ~x:"module name" (string_all Modname.char_is_valid_modchar (strip_ext n ~ext:".ml")) in let name = ask valid_name "What is the name of your project ?" in let obuild = { Project.make with Project.name = name ; Project.version = "0.0.0" ; Project.synopsis = "my new project" ; Project.obuild_ver = 1 } in let ty = ask (expecting_output ["1";"2"]) "What do you want to build ? 1: executable, 2: library" in let question_obits obits = let dir = ask valid_fp "What is the directory name where to find the source ? (default .)" in { obits with target_srcdir = [fp dir] } in let question_cbits cbits = cbits in let project = let compose f g x = f (g x) in match ty with | "1" -> let main = ask valid_fn "What is the name of your main ?" in let nexe = Executable.make name in let itarget = nexe.Executable.target in let target = { itarget with target_obits = question_obits itarget.target_obits ; target_cbits = question_cbits itarget.target_cbits } in { obuild with exes = [ { nexe with Executable.main = fn main; Executable.target = target } ] } | "2" -> let modules = List.map (fun m -> String.capitalize $ strip_ext ~ext:".ml" m) (ask_many valid_modname "Add a module ? (enter to terminate)") in let nlib = Library.make_from_string name in let itarget = nlib.Library.target in let target = { itarget with target_obits = question_obits itarget.target_obits ; target_cbits = question_cbits itarget.target_cbits } in { obuild with libs = [ { nlib with Library.modules = List.map (compose Hier.of_modname Modname.wrap) modules; Library.target = target } ] } | _ -> assert false in project obuild-obuild-v0.1.10/src/install.ml000066400000000000000000000113221327005302600172750ustar00rootroot00000000000000open Obuild open Ext.Fugue open Ext.Filepath open Printf open Project open Types open Target open Helper open Gconf let list_target_files_pred target pred = let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in Build.sanity_check build_dir target; (* don't play with matches *) let matches = Ext.Filesystem.list_dir_pred pred build_dir in (build_dir, matches) let list_lib_files lib build_dir = list_target_files_pred lib (fun f -> if (fn_to_string f) = "META" then true else match Filetype.of_filepath (build_dir f) with | Filetype.FileCMX | Filetype.FileCMI | Filetype.FileA | Filetype.FileCMXS | Filetype.FileCMXA | Filetype.FileCMA | Filetype.FileCMT | Filetype.FileCMTI -> true | _ -> false) let list_exe_files lib build_dir = list_target_files_pred lib (fun f -> match Filetype.of_filepath (build_dir f) with | Filetype.FileEXE -> true | _ -> false) let opam_install_file proj_file flags = let install_path = fp (proj_file.name ^ ".install") in Utils.generateFile install_path (fun add -> let all_targets = Project.get_all_installable_targets proj_file flags in let print_target_files target list_files_fun = let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in let (_, files) = list_files_fun target build_dir in List.iter (fun file -> let file_str = fn_to_string file in add (sprintf " \"%s/%s\" {\"%s\"}\n" (fp_to_string build_dir) file_str file_str) ) files in add (sprintf "%s: [\n" "lib"); List.iter (fun target -> match target.target_name with | Name.Lib _ -> print_target_files target list_lib_files | _ -> ()) all_targets; add ("]\n"); add (sprintf "%s: [\n" "bin"); List.iter (fun target -> match target.target_name with | Name.Exe _ -> print_target_files target list_exe_files | _ -> ()) all_targets; add ("]\n"); ) let lib_to_meta proj_file lib = let requires_of_lib lib = let deps = lib.Library.target.target_obits.target_builddeps in [ ([], List.map (fun d -> fst d) deps) ] in let set_meta_field_from_lib pkg lib = { pkg with Meta.Pkg.requires = requires_of_lib lib; Meta.Pkg.description = if lib.Library.description <> "" then lib.Library.description else proj_file.description; Meta.Pkg.archives = [ ([Meta.Predicate.Byte] , fn_to_string (Libname.to_cmca ByteCode Normal lib.Library.name)); ([Meta.Predicate.Byte; Meta.Predicate.Plugin] , fn_to_string (Libname.to_cmca ByteCode Normal lib.Library.name)); ([Meta.Predicate.Native], fn_to_string (Libname.to_cmca Native Normal lib.Library.name)) ] @ (if (Gconf.get_target_option "library-plugin") then [([Meta.Predicate.Native; Meta.Predicate.Plugin], fn_to_string (Libname.to_cmxs Normal lib.Library.name))] else []) } in let subPkgs = List.map (fun sub -> let npkg = Meta.Pkg.make (list_last (Libname.to_string_nodes sub.Library.name)) in set_meta_field_from_lib npkg sub ) lib.Library.subs in let pkg = set_meta_field_from_lib (Meta.Pkg.make "") lib in { pkg with Meta.Pkg.version = proj_file.version; Meta.Pkg.subs = subPkgs } let write_lib_meta projFile lib = let dir = Dist.get_build_exn (Dist.Target lib.Library.target.target_name) in let metadir_path = dir fn "META" in let pkg = lib_to_meta projFile lib in Meta.Pkg.write metadir_path pkg let copy_files files dest_dir dir_name = List.iter (fun (build_dir, build_files) -> List.iter (fun build_file -> Ext.Filesystem.copy_file (build_dir build_file) ((dest_dir dir_name) build_file) ) build_files; ) files let install_lib proj_file lib dest_dir = write_lib_meta proj_file lib; let all_files = List.map (fun target -> let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in Build.sanity_check build_dir target; list_lib_files target build_dir ) (Project.Library.to_targets lib) in let dir_name = fn (Libname.to_string lib.Project.Library.name) in verbose Report "installing library %s\n" (Libname.to_string lib.Project.Library.name); verbose Debug "installing files: %s\n" (Utils.showList "," fn_to_string (List.concat (List.map snd all_files))); copy_files all_files dest_dir dir_name let install_libs proj_file destdir opam = if not opam then List.iter (fun lib -> install_lib proj_file lib destdir) proj_file.Project.libs else List.iter (fun lib -> write_lib_meta proj_file lib) proj_file.Project.libs; obuild-obuild-v0.1.10/src/main.ml000066400000000000000000000341341327005302600165610ustar00rootroot00000000000000open Printf open Ext.Fugue open Ext.Filepath open Ext open Obuild.Types open Obuild.Helper open Obuild.Gconf open Obuild let programName = "obuild" let usageStr cmd = "\nusage: " ^ programName ^ " " ^ cmd ^ " \n\noptions:\n" let read_setup () = FindlibConf.load (); let setup = Dist.read_setup () in (* all_options are restored from setup file *) Configure.set_opts setup; setup let project_read () = try Project.read gconf.strict with exn -> verbose Verbose "exception during project read: %s\n" (Printexc.to_string exn); raise exn let configure argv = let user_flags = ref [] in let user_opts = ref [] in let user_set_flags s = let tweak = if string_startswith "-" s then Configure.ClearFlag (string_drop 1 s) else Configure.SetFlag s in user_flags := tweak :: !user_flags in let set_target_options field value () = let opt_name = if (List.mem field ["examples"; "benchs"; "tests"]) then ("build-" ^ field) else field in user_opts := (opt_name,value) :: !user_opts in let enable_disable_opt opt_name doc = [ ("--enable-" ^ opt_name, Arg.Unit (set_target_options opt_name true), " enable " ^ doc); ("--disable-" ^ opt_name, Arg.Unit (set_target_options opt_name false), "disable " ^ doc) ] in let opts = [ ("--flag", Arg.String user_set_flags, "enable or disable a project's flag"); ("--executable-as-obj", Arg.Unit (set_target_options "executable-as-obj" true), "output executable as obj file"); ("--annot", Arg.Unit (set_target_options "annot" true), "generate .annot files"); ("-g", Arg.Unit (fun () -> (set_target_options "library-debugging" true)(); (set_target_options "executable-debugging" true)(); ), "compilation with debugging"); ("-pg", Arg.Unit (fun () -> (set_target_options "library-profiling" true)(); (set_target_options "executable-profiling" true)(); ), "compilation with profiling") ] in Arg.parse_argv (Array.of_list argv) ( enable_disable_opt "library-bytecode" "library compilation as bytecode" @ enable_disable_opt "library-native" "library compilation as native" @ enable_disable_opt "library-plugin" "library compilation as native plugin" @ enable_disable_opt "executable-bytecode" "executable compilation as bytecode" @ enable_disable_opt "executable-native" "executable compilation as native" @ enable_disable_opt "library-profiling" "library profiling" @ enable_disable_opt "library-debugging" "library debugging" @ enable_disable_opt "executable-profiling" "executable profiling" @ enable_disable_opt "executable-debugging" "executable debugging" @ enable_disable_opt "examples" "building examples" @ enable_disable_opt "benchs" "building benchs" @ enable_disable_opt "tests" "building tests" @ opts ) (fun s -> failwith ("unknown option: " ^ s)) (usageStr "configure"); FindlibConf.load (); let proj_file = Project.read gconf.strict in verbose Report "Configuring %s-%s...\n" proj_file.Project.name proj_file.Project.version; Configure.run proj_file !user_flags !user_opts; (* check build deps of everything buildables *) () let mainBuild argv = let anon = ref [] in let build_options = [ ("-j", Arg.Int (fun i -> gconf.parallel_jobs <- i), "maximum number of jobs in parallel"); ("--jobs", Arg.Int (fun i -> gconf.parallel_jobs <- i), "maximum number of jobs in parallel"); ("--dot", Arg.Unit (fun () -> gconf.dump_dot <- true), "dump dependencies dot files during build"); ("--noocamlmklib", Arg.Unit (fun () -> gconf.ocamlmklib <- false), "do not use ocamlmklib when linking C code") ] in Arg.parse_argv (Array.of_list argv) build_options (fun s -> anon := s :: !anon) (usageStr "build"); Dist.exist (); let setup = read_setup () in let proj_file = project_read () in let flags = Configure.check proj_file true setup in let project = Analyze.prepare proj_file flags in let bstate = Prepare.init project in let dag = match !anon with | [] -> project.Analyze.project_targets_dag | _ -> let targets = List.map Target.Name.of_string !anon in Dag.subset project.Analyze.project_targets_dag targets in Build.build_dag bstate proj_file dag let mainClean _ = if Filesystem.exists (Dist.get_path ()) then begin Filesystem.removeDir (Dist.get_path ()); Dist.remove_dead_links () end let mainSdist argv = let isSnapshot = ref false in Arg.parse_argv (Array.of_list argv) [ ("--snapshot", Arg.Set isSnapshot, "build a snapshot of the project") ] (fun s -> failwith ("unknown option: " ^ s)) (usageStr "sdist"); Dist.check_exn (fun () -> ()); let proj_file = project_read () in Sdist.run proj_file !isSnapshot; () let unimplemented () = eprintf "sorry, you've reached an unimplemented part ! please be patient or send a patch.\n"; exit 1 let mainDoc argv = Arg.parse_argv (Array.of_list argv) [ ] (fun s -> failwith ("unknown option: " ^ s)) (usageStr "doc"); let proj_file = project_read () in Doc.run proj_file; unimplemented () let mainInfer argv = let anon = ref [] in Arg.parse_argv (Array.of_list argv) [ ] (fun s -> anon := s :: !anon) (usageStr "infer"); if !anon = [] then (printf "no modules to infer\n"; exit 0); unimplemented () let mainInstall argv = let dest_dir = ref "" in let opam_install = ref false in Arg.parse_argv (Array.of_list argv) [ ("--destdir", Arg.Set_string dest_dir, "override destination where to install (default coming from findlib configuration)"); ("--opam", Arg.Set opam_install, "only create the .install file for opam (do not copy the files)") ] (fun s -> failwith ("unknown option: " ^ s)) (usageStr "install"); Dist.exist (); let setup = read_setup () in let proj_file = project_read () in let flags = Configure.check proj_file false setup in let dest_dir = (if !dest_dir = "" then (match FindlibConf.get_destdir () with | None -> failwith "no destdir specified, and no findlib default found" | Some p -> p ) else fp !dest_dir) in (* install all the libs *) Install.install_libs proj_file dest_dir !opam_install; if !opam_install then Install.opam_install_file proj_file flags let mainTest argv = let showTest = ref false in Arg.parse_argv (Array.of_list argv) [ ("--output", Arg.Set showTest, "show test outputs") ] (fun s -> failwith ("unknown option: " ^ s)) (usageStr "test"); let setup = read_setup () in let proj_file = project_read () in let _ = Configure.check proj_file false setup in if not (Gconf.get_target_option "build-tests") then ( eprintf "error: building tests are disabled, re-configure with --enable-tests\n"; exit 1 ); let testTargets = List.map Project.Test.to_target proj_file.Project.tests in if testTargets <> [] then ( let results = List.map (fun test -> let testTarget = Project.Test.to_target test in let outputName = Utils.to_exe_name Normal Native (Target.get_target_dest_name testTarget) in let dir = Dist.get_build_exn (Dist.Target testTarget.Target.target_name) in let exePath = dir outputName in if not (Filesystem.exists exePath) then ( eprintf "error: %s doesn't appears built, make sure 'obuild build' is run first\n" (Target.get_target_name testTarget); exit 1 ); (match Process.run [ fp_to_string exePath ] with | Process.Success (out,_,_) -> if !showTest then print_warnings out; (test.Project.Test.name, true) | Process.Failure err -> print_warnings err; (test.Project.Test.name, false) ) ) proj_file.Project.tests in (* this is just a mockup. expect results displayed in javascript and 3d at some point *) let failed = List.filter (fun (_,x) -> false = x) results in let successes = List.filter (fun (_,x) -> true = x) results in let total = List.length failed + List.length successes in printf "%sSUCCESS%s: %d/%d\n" (color_green()) (color_white()) (List.length successes) total; printf "%sFAILED%s : %d/%d\n" (color_red()) (color_white()) (List.length failed) total; List.iter (fun (n,_) -> printf " %s\n" n) failed; if failed <> [] then exit 1 ) else printf "warning: no tests defined: not doing anything.\n" let mainGet argv = let argv = List.tl argv in let proj_file = project_read () in (* TODO: hardcoded just for now to get basic fields. * - add option for quoting * - optional formating options for multi values (one per line, csv) * - access more complicated fields lib/sublib modules/dependencies, etc * *) match argv with | [] -> eprintf "usage: obuild get \n\n"; exit 1 | [field] -> (match field with | "name" -> printf "%s\n" proj_file.Project.name; | "version" -> printf "%s\n" proj_file.Project.version; | "license" -> printf "%s\n" proj_file.Project.license; | _ -> eprintf "error: unknown field %s\n" field; exit 1 ) | _ -> eprintf "usage: obuild get \n"; exit 1 let mainInit _ = let project = Init.run () in let name = fn (project.Project.name) <.> "obuild" in Project.write (in_current_dir name) project let usageCommands = String.concat "\n" [ "Commands:" ; "" ; " configure Prepare to build the package." ; " build Make this package ready for installation." ; " clean Clean up after a build." ; " sdist Generate a source distribution file (.tar.gz)." ; " doc Generate documentation." ; " install Install this package." ; " test Run the tests" ; " help Help about commands" ] let mainHelp argv = match argv with | [] -> eprintf "usage: obuild help \n\n"; | command::_ -> try let msgs = List.assoc command Help.helpMessages in List.iter (eprintf "%s\n") msgs with Not_found -> eprintf "no helpful documentation for %s\n" command (* parse the global args up the first non option * -opt1 -opt2 <...> * *) let parseGlobalArgs () = let printVersion () = printf "obuild %s\n" Path_generated.project_version; exit 0 in let printHelp () = printf "a rescue team has been dispatched\n"; exit 0 in let expect_param1 optName l f = match l with | [] -> failwith (optName ^ " expect a parameter") | x::xs -> f x; xs in let rec processGlobalArgs l = match l with | x::xs -> if String.length x > 0 && x.[0] = '-' then ( let retXs = match x with | "--help" -> printHelp () | "--version" -> printVersion () | "-v" | "--verbose" -> gconf.verbosity <- Verbose; xs | "--color" -> gconf.color <- true; xs | "-vv" | "--debug" -> gconf.verbosity <- Debug; xs | "-vvv" | "--debug+" | "--debug-with-cmd" -> gconf.verbosity <- DebugPlus; xs | "-q" (* for quiet *) | "--silent" -> gconf.verbosity <- Silent; xs | "--strict" -> gconf.strict <- true; xs | "--findlib-conf" -> expect_param1 x xs (fun p -> Gconf.set_env "findlib-path" p) | "--ocamlopt" -> expect_param1 x xs (fun p -> Gconf.set_env "ocamlopt" p) | "--ocamldep" -> expect_param1 x xs (fun p -> Gconf.set_env "ocamldep" p) | "--ocamlc" -> expect_param1 x xs (fun p -> Gconf.set_env "ocamlc" p) | "--cc" -> expect_param1 x xs (fun p -> Gconf.set_env "cc" p) | "--ar" -> expect_param1 x xs (fun p -> Gconf.set_env "ar" p) | "--pkg-config"-> expect_param1 x xs (fun p -> Gconf.set_env "pkgconfig" p) | "--ranlib" -> expect_param1 x xs (fun p -> Gconf.set_env "ranlib" p) | _ -> failwith ("unknown global option: " ^ x) in processGlobalArgs retXs ) else l | [] -> [] in processGlobalArgs (List.tl (Array.to_list Sys.argv)) let knownCommands = [ ("configure", configure) ; ("build", mainBuild) ; ("clean", mainClean) ; ("sdist", mainSdist) ; ("install", mainInstall) ; ("init", mainInit) ; ("infer", mainInfer) ; ("test", mainTest) ; ("get", mainGet) ; ("doc", mainDoc) ; ("help", mainHelp) ] let defaultMain () = let args = parseGlobalArgs () in if List.length args = 0 then ( eprintf "usage: %s [options]\n\n%s\n" Sys.argv.(0) usageCommands; exit 1 ); let cmd = List.hd args in try let mainF = List.assoc cmd knownCommands in mainF args with Not_found -> eprintf "error: unknown command: %s\n\n known commands:\n" cmd; List.iter (eprintf " %s\n") (List.map fst knownCommands); exit 1 let () = try defaultMain () with | Init.ProjectAlreadyExists -> eprintf "error: found another project file in this directory. cannot run init in an already existing project\n"; exit 12 | Init.AbortedByUser -> eprintf "init aborted. nothing written\n"; exit 0 | exn -> Exception.show exn obuild-obuild-v0.1.10/src/sdist.ml000066400000000000000000000040611327005302600167570ustar00rootroot00000000000000open Ext.Fugue open Ext.Filepath open Ext open Obuild.Helper open Obuild.Target open Obuild.Gconf open Obuild let run projFile isSnapshot = let name = projFile.Project.name in let ver = projFile.Project.version in let sdistDir = name ^ "-" ^ ver in let sdistName = fn (sdistDir ^ ".tar.gz") in let dest = Dist.get_path () fn sdistDir in let currentDir = Unix.getcwd () in let _ = Filesystem.mkdirSafe dest 0o755 in (* copy project file and extra source files *) Filesystem.copy_to_dir (Project.findPath ()) dest; maybe_unit (fun src -> Filesystem.copy_to_dir src dest) projFile.Project.license_file; (* copy all libs modules *) let copy_obits obits = List.iter (fun dir -> Filesystem.iterate (fun ent -> let fpath = dir ent in match Filetype.of_filepath fpath with | Filetype.FileML | Filetype.FileMLI -> Filesystem.copy_to_dir fpath dest | _ -> () ) dir) obits.target_srcdir in let copy_cbits cbits = Filesystem.iterate (fun ent -> let fpath = cbits.target_cdir ent in match Filetype.of_filepath fpath with | Filetype.FileC | Filetype.FileH -> Filesystem.copy_to_dir fpath dest | _ -> () ) cbits.target_cdir in let copy_target target = copy_obits target.target_obits; copy_cbits target.target_cbits; () in let copy_lib lib = List.iter copy_target (Project.Library.to_targets lib) in List.iter copy_lib projFile.Project.libs; List.iter (fun exe -> copy_target (Project.Executable.to_target exe)) projFile.Project.exes; List.iter (fun extra -> Filesystem.copy_to_dir extra dest) projFile.Project.extra_srcs; finally (fun () -> Unix.chdir (fp_to_string (Dist.get_path ())); Prog.runTar (fn_to_string sdistName) sdistDir ) (fun () -> Unix.chdir currentDir); verbose Report "Source tarball created: %s\n" (fp_to_string (Dist.get_path () sdistName)); () obuild-obuild-v0.1.10/src/simple.ml000066400000000000000000000127661327005302600171350ustar00rootroot00000000000000(* simple builder *) open Printf open Ext.Fugue open Ext.Filepath open Ext open Obuild.Project open Obuild.Target open Obuild.Gconf open Obuild exception NoMain exception TooManyArgs let main () = let buildNative = ref true in let profiling = ref false in let debugging = ref false in let srcDir = ref currentDir in let cDir = ref currentDir in let depends = ref [] in let cpkgs = ref [] in let cfiles = ref [] in let cincludes = ref [] in let clibpaths = ref [] in let clibs = ref [] in let set_fp r v = r := fp v in let append f l v = l := f v :: !l in let append_several (f: string -> Obuild.Libname.t) (l: Obuild.Libname.t list ref) (v: string): unit = let values = string_split ',' v in let values' = List.rev_map f values in l := List.rev_append values' !l in let anonParams = ref [] in let removeDist = ref true in Arg.parse [ ("--debug", Arg.Unit (fun () -> gconf.verbosity <- DebugPlus; removeDist := false), "activate build system debug") ; ("--native", Arg.Set buildNative , "build native executable") ; ("--bytecode", Arg.Clear buildNative, "build bytecode executable") ; ("-p", Arg.Set profiling, "build with profiling") ; ("-g", Arg.Set debugging, "build with debugging") ; ("--srcdir", Arg.String (set_fp srcDir), "where to find the ML sources (default: current directory)") ; ("--cdir", Arg.String (set_fp cDir), "where to find the C sources (default: current directory)") ; ("--cinclude", Arg.String (append fp cincludes), "append one path to the C include files") ; ("--clibpath", Arg.String (append fp clibpaths), "append one path to the list of path") ; ("--clib", Arg.String (append id clibs), "append one system library") ; ("--cfile", Arg.String (append fn cfiles), "append one c file") ; ("--cpkg", Arg.String (append id cpkgs), "append one c pckage") ; ("--dep", Arg.String (append Libname.of_string depends), "append one dependency") ; ("--deps", Arg.String (append_several Libname.of_string depends), "x,y,z append dependencies x, y and z") ; ("--depends", Arg.String (append Libname.of_string depends), "append one dependency") ] (fun anon -> anonParams := anon :: !anonParams) "usage: obuild-simple [opts] main.ml"; let main = match !anonParams with | [] -> raise NoMain | [x] -> x | _ -> raise TooManyArgs in Gconf.set_target_options "executable-native" !buildNative; Gconf.set_target_options "executable-bytecode" (not !buildNative); Gconf.set_target_options "executable-profiling" (!profiling); Gconf.set_target_options "executable-debugging" (!debugging); let name = Filename.chop_extension main in let target = { target_name = Name.Exe name ; target_type = Typ.Exe ; target_cbits = { target_cdir = !cDir ; target_csources = List.rev !cfiles ; target_cflags = [] ; target_clibs = List.rev !clibs ; target_clibpaths = List.rev !clibpaths ; target_cpkgs = List.map (fun p -> (p, None)) !cpkgs (* no constraints *) } ; target_obits = { target_srcdir = [!srcDir]; target_builddeps = List.map (fun p -> (p, None)) !depends; (* no constraints *) target_oflags = []; target_pp = None; target_extradeps = []; target_stdlib = Stdlib_Standard; } ; target_buildable = BoolConst true ; target_installable = BoolConst true ; target_extras = [] } in let exe = { Executable.name = name ; Executable.main = fn main ; Executable.target = target } in let project_config = { Project.make with Project.name = name ; Project.version = "0.0.0" ; Project.obuild_ver = 1 ; Project.exes = [exe] } in let file_or_link_exists fn = try let _ = Unix.lstat fn in true with _ -> false in let tmpDir = Filesystem.mktemp_dir_in "dist-" in Dist.set_path tmpDir; try finally (fun () -> Dist.create_maybe (); let _ = Dist.create_build (Dist.Autogen) in let buildDir = Dist.create_build (Dist.Target exe.Executable.target.target_name) in FindlibConf.load (); ignore(Configure.check_ocaml ()); let project = Analyze.prepare project_config [] in let bstate = Prepare.init project in Build.build_exe bstate exe; let files = Build.get_destination_files exe.Executable.target in List.iter (fun file -> printf "copying %s to %s\n" (fp_to_string (buildDir file)) (fp_to_string $ in_current_dir file); if(file_or_link_exists (fp_to_string $ in_current_dir file)) then Unix.unlink (fp_to_string $ in_current_dir file); Filesystem.copy_file (buildDir file) (in_current_dir file) ) files ) (fun () -> if !removeDist then Filesystem.removeDir tmpDir) with exn -> Exception.show exn let () = try main () with | NoMain -> eprintf "error: missing main argument, expecting one ml file as parameter\n"; exit 1 | TooManyArgs -> eprintf "too many arguments, expecting just one ml file as parameter\n"; exit 1 obuild-obuild-v0.1.10/tests/000077500000000000000000000000001327005302600156515ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/dependencies/000077500000000000000000000000001327005302600202775ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/dependencies/camlp4/000077500000000000000000000000001327005302600214575ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/dependencies/camlp4/main.ml000066400000000000000000000001621327005302600227340ustar00rootroot00000000000000module Test = struct type t = { t1 : string; t2 : int option; t3 : float; } with fields end obuild-obuild-v0.1.10/tests/dependencies/camlp4/test.obuild000066400000000000000000000002171327005302600236360ustar00rootroot00000000000000name: test version: 0.1.0 synopsis: Demo obuild-ver: 1 executable test main: main.ml src-dir: . pp: camlp4o build-deps: pa_fields_convobuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/000077500000000000000000000000001327005302600221455ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/binprot.ml000066400000000000000000000003571327005302600241610ustar00rootroot00000000000000open Bin_prot.Std type t = { i: int; f: float } [@@deriving bin_io] let () = let x = { i = 2048 ; f = 3.1415 } in let buff = Bin_prot.Utils.bin_dump bin_writer_t x in let y = bin_read_t buff ~pos_ref:(ref 0) in assert(x = y) obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/both.ml000066400000000000000000000002341327005302600234320ustar00rootroot00000000000000open Lwt let test () = let%lwt x = return 3 in return (x + 1 = 4) let _ = let a = [%sexp (define a "hi there!")] in Printf.printf "done\n" obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/deriving.ml000066400000000000000000000001621327005302600243050ustar00rootroot00000000000000 type test = S of string [@@deriving show] let () = let t = S "string" in Printf.printf "%s\n" (show_test t) obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/hello.ml000066400000000000000000000001151327005302600235770ustar00rootroot00000000000000let _ = let a = [%sexp (define a "hi there!")] in Printf.printf "done\n" obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/hello.obuild000066400000000000000000000011461327005302600244520ustar00rootroot00000000000000name: hello version: 1.0 obuild-ver: 1 executable hello src-dir: . main-is: hello.ml build-deps: ppx_sexp executable hello_lwt src-dir: . main-is: hello_lwt.ml build-deps: lwt.ppx executable both src-dir: . main-is: both.ml build-deps: lwt.ppx, ppx_sexp executable show src-dir: . main-is: show.ml build-deps: ppx_deriving.show Executable deriving src-dir: . build-deps: ppx_deriving.std main-is: deriving.ml Executable sexp src-dir: . build-deps: ppx_sexp_conv main-is: sexp.ml Executable binprot src-dir: . build-deps: ppx_bin_prot, bin_prot main-is: binprot.ml obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/hello_lwt.ml000066400000000000000000000001561327005302600244720ustar00rootroot00000000000000open Lwt let test () = let%lwt x = return 3 in return (x + 1 = 4) let _ = Printf.printf "Done\n" obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/main.ml000066400000000000000000000103621327005302600234250ustar00rootroot00000000000000open Test open Lwt let suite = suite "ppx" [ test "let" (fun () -> let%lwt x = return 3 in return (x + 1 = 4) ) ; test "nested let" (fun () -> let%lwt x = return 3 in let%lwt y = return 4 in return (x + y = 7) ) ; test "and let" (fun () -> let%lwt x = return 3 and y = return 4 in return (x + y = 7) ) ; test "match" (fun () -> let x = Lwt.return (Some 3) in match%lwt x with | Some x -> return (x + 1 = 4) | None -> return false ) ; test "match-exn" (fun () -> let x = Lwt.return (Some 3) in let x' = Lwt.fail Not_found in let%lwt a = match%lwt x with | exception Not_found -> return false | Some x -> return (x = 3) | None -> return false and b = match%lwt x' with | exception Not_found -> return true | _ -> return false in Lwt.return (a && b) ) ; test "if" (fun () -> let x = Lwt.return true in let%lwt a = if%lwt x then Lwt.return_true else Lwt.return_false in let%lwt b = if%lwt x>|= not then Lwt.return_false else Lwt.return_true in (if%lwt x >|= not then Lwt.return_unit) >>= fun () -> Lwt.return (a && b) ) ; test "for" (* Test for proper sequencing *) (fun () -> let r = ref [] in let f x = let%lwt () = Lwt_unix.sleep 0.2 in Lwt.return (r := x :: !r) in let%lwt () = for%lwt x = 3 to 5 do f x done in return (!r = [5 ; 4 ; 3]) ) ; test "while" (* Test for proper sequencing *) (fun () -> let r = ref [] in let f x = let%lwt () = Lwt_unix.sleep 0.2 in Lwt.return (r := x :: !r) in let%lwt () = let c = ref 2 in while%lwt !c < 5 do incr c ; f !c done in return (!r = [5 ; 4 ; 3]) ) ; test "assert" (fun () -> let%lwt () = assert%lwt true in return true ) ; test "raise" (fun () -> Lwt.catch (fun () -> [%lwt raise Not_found]) (fun exn -> return (exn = Not_found)) ) ; test "try" (fun () -> try%lwt Lwt.fail Not_found with _ -> return true ) [@warning("@8@11")] ; test "try raise" (fun () -> try%lwt raise Not_found with _ -> return true ) [@warning("@8@11")] ; test "try fallback" (fun () -> try%lwt try%lwt Lwt.fail Not_found with Failure _ -> return false with Not_found -> return true ) [@warning("@8@11")] ; test "finally body" (fun () -> let x = ref false in begin (try%lwt return_unit with | _ -> return_unit ) [%finally x := true; return_unit] end >>= fun () -> return !x ) ; test "finally exn" (fun () -> let x = ref false in begin (try%lwt raise Not_found with | _ -> return_unit ) [%finally x := true; return_unit] end >>= fun () -> return !x ) ; test "finally exn default" (fun () -> let x = ref false in try%lwt ( raise Not_found )[%finally x := true; return_unit] >>= fun () -> return false with Not_found -> return !x ) ; test "sequence" (fun () -> let lst = ref [] in (lst := 2 :: !lst; Lwt.return_unit) >> (lst := 1 :: !lst; Lwt.return_unit) >> (Lwt.return (!lst = [1;2])) ) ; test "log" (fun () -> Lwt_log.ign_debug "bar"; Lwt_log.debug "foo" >>= fun () -> Lwt_log.info_f "baz" >>= fun () -> return_true ) ; test "structure let" (fun () -> let module M = struct let%lwt result = Lwt.return_true end in Lwt.return M.result ) ; ] let _ = Test.run "ppx" [ suite ] obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/sexp.ml000066400000000000000000000002711327005302600234560ustar00rootroot00000000000000open Sexplib.Std type t = { i: int; f: float } [@@deriving sexp] let () = let x = { i = 2048 ; f = 3.1415 } in let s = sexp_of_t x in let y = t_of_sexp s in assert(x = y) obuild-obuild-v0.1.10/tests/dependencies/ppx_sexp/show.ml000066400000000000000000000001541327005302600234570ustar00rootroot00000000000000type point2d = float * float [@@deriving show] let _ = Printf.printf "%s\n" (show_point2d (1.1,2.2)); obuild-obuild-v0.1.10/tests/full/000077500000000000000000000000001327005302600166135ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autogenerated/000077500000000000000000000000001327005302600214425ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autogenerated/p3.ml000066400000000000000000000001411327005302600223120ustar00rootroot00000000000000open Path_generated open Printf let () = printf "project version is : %s\n" project_version obuild-obuild-v0.1.10/tests/full/autogenerated/p3.obuild000066400000000000000000000001071327005302600231620ustar00rootroot00000000000000name: p3 version: 9.1.23 obuild-ver: 1 executable p3 main-is: p3.ml obuild-obuild-v0.1.10/tests/full/autopack/000077500000000000000000000000001327005302600204225ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autopack/autopack.obuild000066400000000000000000000001411327005302600234250ustar00rootroot00000000000000name: autopack version: 1.0 obuild-ver: 1 executable autopack src-dir: src main-is: main.ml obuild-obuild-v0.1.10/tests/full/autopack/src/000077500000000000000000000000001327005302600212115ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autopack/src/a.ml000066400000000000000000000000221327005302600217550ustar00rootroot00000000000000let foo = "A.foo" obuild-obuild-v0.1.10/tests/full/autopack/src/b/000077500000000000000000000000001327005302600214325ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autopack/src/b/a.ml000066400000000000000000000000241327005302600222000ustar00rootroot00000000000000let foo = "B.A.foo" obuild-obuild-v0.1.10/tests/full/autopack/src/b/c.ml000066400000000000000000000000451327005302600222050ustar00rootroot00000000000000let foo = "B.C.foo" let test = A.foo obuild-obuild-v0.1.10/tests/full/autopack/src/main.ml000066400000000000000000000002051327005302600224640ustar00rootroot00000000000000open Printf let () = printf "A.foo: %s\n" A.foo; printf "B.A.foo: %s\n" B.A.foo; printf "B.C.foo: %s\n" B.C.foo; () obuild-obuild-v0.1.10/tests/full/autopack2/000077500000000000000000000000001327005302600205045ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autopack2/autopack2.obuild000066400000000000000000000001431327005302600235730ustar00rootroot00000000000000name: autopack2 version: 1.0 obuild-ver: 1 executable autopack2 src-dir: src main-is: main.ml obuild-obuild-v0.1.10/tests/full/autopack2/src/000077500000000000000000000000001327005302600212735ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autopack2/src/a.ml000066400000000000000000000000221327005302600220370ustar00rootroot00000000000000let foo = "A.foo" obuild-obuild-v0.1.10/tests/full/autopack2/src/b/000077500000000000000000000000001327005302600215145ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autopack2/src/b/a.ml000066400000000000000000000000241327005302600222620ustar00rootroot00000000000000let foo = "B.A.foo" obuild-obuild-v0.1.10/tests/full/autopack2/src/b/abc/000077500000000000000000000000001327005302600222415ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/autopack2/src/b/abc/foo.ml000066400000000000000000000000321327005302600233510ustar00rootroot00000000000000let foo = "B.Abc.Foo.foo" obuild-obuild-v0.1.10/tests/full/autopack2/src/b/c.ml000066400000000000000000000000241327005302600222640ustar00rootroot00000000000000let foo = "B.C.foo" obuild-obuild-v0.1.10/tests/full/autopack2/src/main.ml000066400000000000000000000002651327005302600225540ustar00rootroot00000000000000open Printf let () = printf "A.foo: %s\n" A.foo; printf "B.A.foo: %s\n" B.A.foo; printf "B.Abc.Foo.foo: %s\n" B.Abc.Foo.foo; printf "B.C.foo: %s\n" B.C.foo; () obuild-obuild-v0.1.10/tests/full/complex/000077500000000000000000000000001327005302600202625ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex/complex.obuild000066400000000000000000000005261327005302600231340ustar00rootroot00000000000000name: complex version: 1.0 obuild-ver: 1 library complex src-dir: lib modules: Math, Imaginary sub real src-dir: lib_real modules: Foo, Bar build-deps: complex executable complex src-dir: src main-is: main1.ml build-deps: complex.real executable complex2 src-dir: src main-is: main.ml build-deps: complex obuild-obuild-v0.1.10/tests/full/complex/lib/000077500000000000000000000000001327005302600210305ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex/lib/imaginary.ml000066400000000000000000000002661327005302600233460ustar00rootroot00000000000000 let imaginary_plus t1 t2 = { Math.Types.real = Math.Accessor.get_real t1 + t2.Math.Types.real ; Math.Types.imag = t1.Math.Types.imag + Math.Accessor.get_imag t2 } obuild-obuild-v0.1.10/tests/full/complex/lib/math/000077500000000000000000000000001327005302600217615ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex/lib/math/accessor.ml000066400000000000000000000001221327005302600241100ustar00rootroot00000000000000let get_real (t: Types.t) = t.Types.real let get_imag (t: Types.t) = t.Types.imag obuild-obuild-v0.1.10/tests/full/complex/lib/math/types.ml000066400000000000000000000000451327005302600234560ustar00rootroot00000000000000type t = { real : int ; imag : int } obuild-obuild-v0.1.10/tests/full/complex/lib_real/000077500000000000000000000000001327005302600220335ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex/lib_real/bar.ml000066400000000000000000000000541327005302600231300ustar00rootroot00000000000000 let real_list l = List.map Foo.make_real l obuild-obuild-v0.1.10/tests/full/complex/lib_real/foo.ml000066400000000000000000000000721327005302600231470ustar00rootroot00000000000000open Math.Types let make_real x = { real = x; imag = 0 } obuild-obuild-v0.1.10/tests/full/complex/src/000077500000000000000000000000001327005302600210515ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex/src/main.ml000066400000000000000000000003551327005302600223320ustar00rootroot00000000000000open Imaginary open Math let () = let t1 = { Types.real = 0; Types.imag = 1 } in let t2 = { Types.real = 1; Types.imag = 2 } in let t3 = imaginary_plus t1 t2 in Printf.printf "real = %d\n" (Accessor.get_real t3); () obuild-obuild-v0.1.10/tests/full/complex/src/main1.ml000066400000000000000000000003101327005302600224020ustar00rootroot00000000000000open Bar let () = let l = real_list [1;2;3] in List.iter (fun i -> Printf.printf "%d.%d\n" (Math.Accessor.get_real i) (Math.Accessor.get_imag i)) l obuild-obuild-v0.1.10/tests/full/complex2/000077500000000000000000000000001327005302600203445ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex2/complex.obuild000066400000000000000000000005401327005302600232120ustar00rootroot00000000000000name: complex version: 1.0 obuild-ver: 1 library complex src-dir: lib,lib2 modules: Math, Imaginary sub real src-dir: lib_real modules: Foo, Bar build-deps: complex executable complex src-dir: src main-is: main1.ml build-deps: complex.real executable complex2 src-dir: src,src2 main-is: main.ml build-deps: complex obuild-obuild-v0.1.10/tests/full/complex2/lib/000077500000000000000000000000001327005302600211125ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex2/lib/math/000077500000000000000000000000001327005302600220435ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex2/lib/math/accessor.ml000066400000000000000000000001221327005302600241720ustar00rootroot00000000000000let get_real (t: Types.t) = t.Types.real let get_imag (t: Types.t) = t.Types.imag obuild-obuild-v0.1.10/tests/full/complex2/lib/math/types.ml000066400000000000000000000000451327005302600235400ustar00rootroot00000000000000type t = { real : int ; imag : int } obuild-obuild-v0.1.10/tests/full/complex2/lib2/000077500000000000000000000000001327005302600211745ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex2/lib2/imaginary.ml000066400000000000000000000002661327005302600235120ustar00rootroot00000000000000 let imaginary_plus t1 t2 = { Math.Types.real = Math.Accessor.get_real t1 + t2.Math.Types.real ; Math.Types.imag = t1.Math.Types.imag + Math.Accessor.get_imag t2 } obuild-obuild-v0.1.10/tests/full/complex2/lib_real/000077500000000000000000000000001327005302600221155ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex2/lib_real/bar.ml000066400000000000000000000000541327005302600232120ustar00rootroot00000000000000 let real_list l = List.map Foo.make_real l obuild-obuild-v0.1.10/tests/full/complex2/lib_real/foo.ml000066400000000000000000000000721327005302600232310ustar00rootroot00000000000000open Math.Types let make_real x = { real = x; imag = 0 } obuild-obuild-v0.1.10/tests/full/complex2/src/000077500000000000000000000000001327005302600211335ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex2/src/main1.ml000066400000000000000000000003101327005302600224640ustar00rootroot00000000000000open Bar let () = let l = real_list [1;2;3] in List.iter (fun i -> Printf.printf "%d.%d\n" (Math.Accessor.get_real i) (Math.Accessor.get_imag i)) l obuild-obuild-v0.1.10/tests/full/complex2/src2/000077500000000000000000000000001327005302600212155ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/complex2/src2/main.ml000066400000000000000000000003551327005302600224760ustar00rootroot00000000000000open Imaginary open Math let () = let t1 = { Types.real = 0; Types.imag = 1 } in let t2 = { Types.real = 1; Types.imag = 2 } in let t3 = imaginary_plus t1 t2 in Printf.printf "real = %d\n" (Accessor.get_real t3); () obuild-obuild-v0.1.10/tests/full/dep-uri/000077500000000000000000000000001327005302600201605ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/dep-uri/p2.ml000066400000000000000000000001761327005302600210370ustar00rootroot00000000000000open Uri open Printf let () = let u = Uri.make ~scheme:"http" ~host:"foo!.com" () in printf "%s\n" (Uri.to_string u) obuild-obuild-v0.1.10/tests/full/dep-uri/p2.obuild000066400000000000000000000001551327005302600217020ustar00rootroot00000000000000name: p2 version: 1.0 obuild-ver: 1 ocaml-version: >=3.12.1 executable p2 main-is: p2.ml build-deps: uri obuild-obuild-v0.1.10/tests/full/parser/000077500000000000000000000000001327005302600201075ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/parser/lexer.mll000066400000000000000000000013361327005302600217370ustar00rootroot00000000000000(* file: lexer.mll *) (* Lexical analyzer returns one of the tokens: the token NUM of a floating point number, operators (PLUS, MINUS, MULTIPLY, DIVIDE, CARET, UMINUS), or NEWLINE. It skips all blanks and tabs, unknown characters and raises End_of_file on EOF. *) { open Rpncalc (* Assumes the parser file is "rpncalc.mly". *) } let digit = ['0'-'9'] rule token = parse | [' ' '\t'] { token lexbuf } | '\n' { NEWLINE } | digit+ | "." digit+ | digit+ "." digit* as num { NUM (float_of_string num) } | '+' { PLUS } | '-' { MINUS } | '*' { MULTIPLY } | '/' { DIVIDE } | '^' { CARET } | 'n' { UMINUS } | _ { token lexbuf } | eof { raise End_of_file } obuild-obuild-v0.1.10/tests/full/parser/main.ml000066400000000000000000000004551327005302600213710ustar00rootroot00000000000000(* file: main.ml *) (* Assumes the parser file is "rpncalc.mly" and the lexer file is "lexer.mll". *) let main () = try let lexbuf = Lexing.from_channel stdin in while true do Rpncalc.input Lexer.token lexbuf done with End_of_file -> exit 0 let _ = Printexc.print main () obuild-obuild-v0.1.10/tests/full/parser/parser.obuild000066400000000000000000000001141327005302600225770ustar00rootroot00000000000000name: parser version: 1.0 obuild-ver: 1 executable main main-is: main.ml obuild-obuild-v0.1.10/tests/full/parser/rpncalc.mly000066400000000000000000000013621327005302600222560ustar00rootroot00000000000000/* file: rpcalc.mly */ /* Reverse polish notation calculator. */ %{ open Printf %} %token NUM %token PLUS MINUS MULTIPLY DIVIDE CARET UMINUS %token NEWLINE %start input %type input %% /* Grammar rules and actions follow */ input: /* empty */ { } | input line { } ; line: NEWLINE { } | exp NEWLINE { printf "\t%.10g\n" $1; flush stdout } ; exp: NUM { $1 } | exp exp PLUS { $1 +. $2 } | exp exp MINUS { $1 -. $2 } | exp exp MULTIPLY { $1 *. $2 } | exp exp DIVIDE { $1 /. $2 } /* Exponentiation */ | exp exp CARET { $1 ** $2 } /* Unary minus */ | exp UMINUS { -. $1 } ; %% obuild-obuild-v0.1.10/tests/full/run000077500000000000000000000017331327005302600173510ustar00rootroot00000000000000#!/bin/bash OBUILD=$(pwd)/../../dist/build/obuild/obuild if [ ! -x ${OBUILD} ]; then echo "obuild has not been built" exit 1 fi TESTS="simple autogenerated with-c dep-uri autopack autopack2 complex complex2" if [ $# -gt 0 ]; then TESTS="$1" DEBUG="--debug+" else DEBUG="" fi RED="\033[1;31m" GREEN="\033[1;32m" BLUE="\033[1;34m" WHITE="\033[0m" for t in ${TESTS} do cd ${t} echo -e "$BLUE ==== test ${t} ====${WHITE}" ${OBUILD} clean ${OBUILD} --strict configure --enable-library-bytecode --enable-executable-bytecode --enable-library-debugging --enable-library-profiling --enable-executable-profiling --enable-executable-debugging --annot if [ $? -ne 0 ]; then echo -e "${RED}ERROR${WHITE}: configure failed" cd .. continue fi ${OBUILD} ${DEBUG} build if [ $? -ne 0 ]; then echo -e "${RED}ERROR${WHITE}: build failed" cd .. continue fi echo -e "${GREEN}SUCCESS${WHITE}: $t passed" cd .. done for t in ${TESTS} do cd ${t} ${OBUILD} clean cd .. done obuild-obuild-v0.1.10/tests/full/simple/000077500000000000000000000000001327005302600201045ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/simple/p1.ml000066400000000000000000000000221327005302600207500ustar00rootroot00000000000000let inc a = a + 1 obuild-obuild-v0.1.10/tests/full/simple/p1.obuild000066400000000000000000000000761327005302600216270ustar00rootroot00000000000000name: p1 version: 1.0 obuild-ver: 1 library p1 modules: P1 obuild-obuild-v0.1.10/tests/full/test/000077500000000000000000000000001327005302600175725ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/test/test.obuild000066400000000000000000000001601327005302600217460ustar00rootroot00000000000000name: test version: 0.1 obuild-ver: 1 library abc modules: X test abc main-is: testX.ml build-deps: abc obuild-obuild-v0.1.10/tests/full/test/testX.ml000066400000000000000000000003701327005302600212330ustar00rootroot00000000000000let failed = ref false let runTest name f = let v = f () in if not v then failed := true; Printf.printf "test %s: %b\n" name v let () = runTest "foo works" (fun () -> X.foo 12 12 = 12 + 12); if !failed then exit 1 else exit 0 obuild-obuild-v0.1.10/tests/full/test/x.ml000066400000000000000000000000241327005302600203670ustar00rootroot00000000000000let foo a b = a + b obuild-obuild-v0.1.10/tests/full/with-c/000077500000000000000000000000001327005302600200065ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/full/with-c/cbits.c000066400000000000000000000003341327005302600212560ustar00rootroot00000000000000#include #include #include #include #include CAMLexport value stub_geti(value unit) { CAMLparam1(unit); CAMLreturn(Val_int(10)); } obuild-obuild-v0.1.10/tests/full/with-c/ccall.ml000066400000000000000000000001761327005302600214220ustar00rootroot00000000000000open Printf external geti : unit -> int = "stub_geti" let inc a = a + 1 let () = printf "%d\n" (inc (geti ())); () obuild-obuild-v0.1.10/tests/full/with-c/ccall.obuild000066400000000000000000000001431327005302600222620ustar00rootroot00000000000000name: with-c version: 1.0 obuild-ver: 1 executable withc main-is: ccall.ml c-sources: cbits.c obuild-obuild-v0.1.10/tests/simple/000077500000000000000000000000001327005302600171425ustar00rootroot00000000000000obuild-obuild-v0.1.10/tests/simple/deps.build000066400000000000000000000000621327005302600211140ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --deps unix,str deps.ml obuild-obuild-v0.1.10/tests/simple/deps.ml000066400000000000000000000001421327005302600204240ustar00rootroot00000000000000 let main () = let _s = Str.quote "toto" in let _t = Unix.gettimeofday () in () ;; main () obuild-obuild-v0.1.10/tests/simple/gtk.build000066400000000000000000000001061327005302600207450ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --cfile gtk_stubs.c --cpkg gtk+-2.0 gtk.ml obuild-obuild-v0.1.10/tests/simple/gtk.ml000066400000000000000000000001601327005302600202560ustar00rootroot00000000000000external gtk_true : unit -> bool = "stub_gtk_true" let () = Printf.printf "gtk_true(): %b\n" (gtk_true ()) obuild-obuild-v0.1.10/tests/simple/gtk_stubs.c000066400000000000000000000004221327005302600213110ustar00rootroot00000000000000#include #include #include #include #include #include CAMLexport value stub_gtk_true(value unit) { CAMLparam1(unit); int b = gtk_true(); CAMLreturn(Val_int(b ? 1 : 0)); } obuild-obuild-v0.1.10/tests/simple/hello_world.build000066400000000000000000000000511327005302600224710ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} hello_world.ml obuild-obuild-v0.1.10/tests/simple/hello_world.ml000066400000000000000000000000631327005302600220050ustar00rootroot00000000000000let () = Printf.printf "hello world\n"; () obuild-obuild-v0.1.10/tests/simple/run000077500000000000000000000004621327005302600176760ustar00rootroot00000000000000#!/bin/bash export OBUILDSIMPLE=$(pwd)/../../dist/build/obuild-simple/obuild-simple for BUILD in *.build do name=${BUILD/.build/} echo "======== $name =========================" sh ./${BUILD} if [ ! -f $name ]; then echo "[FAILED] building $name " else echo "[SUCCESS] building $name " fi done obuild-obuild-v0.1.10/tests/simple/z.build000066400000000000000000000000731327005302600204340ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --cfile z_stubs.c --clib z z.ml obuild-obuild-v0.1.10/tests/simple/z.ml000066400000000000000000000001721327005302600177450ustar00rootroot00000000000000external adler32 : int -> int = "stub_adler32" let () = let v = adler32 10 in Printf.printf "zerror 10 = %x\n" v obuild-obuild-v0.1.10/tests/simple/z_stubs.c000066400000000000000000000004651327005302600210040ustar00rootroot00000000000000#include #include #include #include #include #include CAMLexport value stub_adler32(value i) { CAMLparam1(i); /* wrong but that's fine */ unsigned int adler = adler32(0L, Z_NULL, 0); CAMLreturn(Val_int(adler)); } obuild-obuild-v0.1.10/tests/test_dag.ml000066400000000000000000000054411327005302600200010ustar00rootroot00000000000000open Obuild let err = ref 0 (* simple dag: a -> b -> c *) let d1 = let d = Dag.init () in Dag.addEdge "A" "B" d; Dag.addEdge "B" "C" d; d (* DAG with a fork * * A -> B -> C -> D -> E -> F * \> C'-> D'-/ *) let d2 = let d = Dag.init () in Dag.addEdgesConnected ["A";"B";"C";"D";"E";"F"] d; Dag.addEdges [ ("B","C'"); ("C'","D'"); ("D'", "E") ] d; d (* DAG * A --------> C * \-> B --/ *) let d3 = let d = Dag.init () in Dag.addEdges [("A","C"); ("A","B"); ("B","C")] d; d (* DAG * A \ /-> C * -> B * A' / \-> C' *) let d4 = let d = Dag.init () in Dag.addEdges [("A","B"); ("A'","B"); ("B","C"); ("B","C'")] d; d let showDeps prefix l = Printf.printf "%s%s\n" prefix (String.concat " -> " l) let assumeEqF f testname expected got = if f expected got then (Printf.printf "SUCCESS %s\n" testname) else (Printf.printf "FAILED %s\n" testname; showDeps "expected:" (List.concat expected); showDeps "got :" got; err := !err + 1) let assumeEq testname expected got = if expected = got then (Printf.printf "SUCCESS %s\n" testname) else (Printf.printf "FAILED %s\n" testname; showDeps "expected:" expected; showDeps "got :" got; err := !err + 1) let listEq a b = let rec loopElem l r = match l with | [] -> (true, r) | _ -> match r with | [] -> (false, r) | e::es -> if List.mem e l then loopElem (List.filter (fun z -> z <> e) l) es else (false, r) in let rec loopGroup l r = match l with | [] -> if r = [] then true else false | g::gs -> let (e,r2) = loopElem g r in if e = true then loopGroup gs r2 else false in loopGroup a b let () = let l1 = Taskdep.linearize d1 Taskdep.FromParent ["A"] in let l2 = Taskdep.linearize d2 Taskdep.FromParent ["A"] in let l2' = Taskdep.linearize d2 Taskdep.FromParent ["C'"] in let l3 = Taskdep.linearize d3 Taskdep.FromParent ["A"] in let l3' = Taskdep.linearize (Dag.transitive_reduction d3) Taskdep.FromParent ["A"] in let l4 = Taskdep.linearize d4 Taskdep.FromParent ["A"; "A'"] in assumeEq "linearization A->B->C" [ "A"; "B"; "C" ] l1; assumeEq "linearization A->B->(C,C')->(D,D')->E->F" ["A";"B";"C";"D";"C'";"D'";"E";"F"] l2; assumeEq "linearization C'->D'->E->F" ["C'";"D'";"E";"F"] l2'; assumeEq "linearization A->(B->C)" ["A";"B";"C"] l3; assumeEq "linearization A->(B->C)" ["A";"B";"C"] l3'; assumeEqF listEq "linearization (A,A')->B->(C,C')" [["A";"A'"];["B"];["C";"C'"]] l4; if !err > 1 then exit 1 else exit 0 obuild-obuild-v0.1.10/tests/test_expr.ml000066400000000000000000000052741327005302600202300ustar00rootroot00000000000000open Obuild let err = ref 0 let assumeEq testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else (Printf.printf "FAILED %s Expected %b Got %b\n" testname expected got; err := !err + 1) let expr_to_string = function | None -> "" | Some expr -> Expr.to_string expr let eval version = function | None -> true | Some expr -> Expr.eval version expr let () = let version1 = "1.7" in let version2 = "1.7.2" in let version3 = "2.0.0.0" in let version4 = "1.12.1alpha" in let (name,expr_ge) = Expr.parse_builddep "uri (>=1.7.2)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ge); assumeEq ">= false" false (eval version1 expr_ge); assumeEq ">= true" true (eval version2 expr_ge); assumeEq ">= true" true (eval version3 expr_ge); assumeEq ">= true" true (eval version4 expr_ge); let (name,expr_lt) = Expr.parse_builddep "uri (<1.7.2)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ge); assumeEq "< true" true (eval version1 expr_lt); assumeEq "< false" false (eval version2 expr_lt); assumeEq "< false" false (eval version3 expr_lt); assumeEq "< false" false (eval version4 expr_lt); let (name,expr_ne) = Expr.parse_builddep "uri (!=1.7.2)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ne); assumeEq "!= true" true (eval version1 expr_ne); assumeEq "!= false" false (eval version2 expr_ne); assumeEq "!= true" true (eval version3 expr_ne); assumeEq "!= true" true (eval version4 expr_ne); let (name,expr_not_eq) = Expr.parse_builddep "uri !(=1.7.2)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_not_eq); assumeEq "! = true" true (eval version1 expr_ne); assumeEq "! = false" false (eval version2 expr_ne); assumeEq "! = true" true (eval version3 expr_ne); assumeEq "! = true" true (eval version4 expr_ne); let (name,expr_comp) = Expr.parse_builddep "uri (<1.7.2) || (>=2.0)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_comp); assumeEq "< | >= = true" true (eval version1 expr_comp); assumeEq "< | >= = false" false (eval version2 expr_comp); assumeEq "< | >= = true" true (eval version3 expr_comp); assumeEq "< | >= = false" false (eval version4 expr_comp); let (name,expr_comp2) = Expr.parse_builddep "uri ((<1.7.2) || (>=2.0) || (=1.7.2))" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_comp2); assumeEq "< | >= = true" true (eval version1 expr_comp2); assumeEq "< | >= = true" true (eval version2 expr_comp2); assumeEq "< | >= = true" true (eval version3 expr_comp2); assumeEq "< | >= = false" false (eval version4 expr_comp2); if !err > 1 then exit 1 else exit 0 obuild-obuild-v0.1.10/tests/test_find.ml000066400000000000000000000213611327005302600201650ustar00rootroot00000000000000open Obuild open Ext let err = ref 0 let assumeEq testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else (Printf.printf "FAILED %s Expected %s Got %s\n" testname expected got; err := !err + 1) let archive_to_string (ps, n) = let pres = List.map (fun p -> Meta.Predicate.to_string p) ps in Printf.sprintf "archive(%s) = [%s]" (String.concat "," pres) n let archives_to_string l = String.concat "\n" (List.map (fun a -> archive_to_string a) l) let () = let meta_unix = "requires = \"\"\n" ^ "description = \"Unix system calls\"\n" ^ "version = \"[distributed with Ocaml]\"\n" ^ "directory = \"^\"\n" ^ "browse_interfaces = \" Unit name: Unix Unit name: UnixLabels \"\n" ^ "archive(byte) = \"unix.cma\"\n" ^ "archive(native) = \"unix.cmxa\"\n" ^ "archive(byte,mt_vm) = \"vmthreads/unix.cma\"\n" in let unix = Meta.parse (Filepath.fp "unix") meta_unix "unix" in let unix_answer = Meta.Pkg.get_archive_with_filter (None, unix) (Libname.of_string "unix") [Meta.Predicate.Byte; Meta.Predicate.Gprof; Meta.Predicate.Mt] in assumeEq "unix description" "Unix system calls" unix.Meta.Pkg.description; assumeEq "unix byte" "archive(byte) = [unix.cma]" (archives_to_string unix_answer); let meta_netstring = "version = \"4.0.2\"\n" ^ "requires = \"str unix netsys \"\n" ^ "description = \"Ocamlnet - String processing library\"\n" ^ "\n" ^ "archive(byte) = \n" ^ " \"netstring.cma\"\n" ^ "archive(byte,toploop) = \n" ^ " \"netstring.cma netstring_top.cmo\"\n" ^ "archive(native) = \n" ^ " \"netstring.cmxa\"\n" ^ "archive(native,gprof) = \n" ^ " \"netstring.p.cmxa\"\n" ^ "archive(byte,-nonetaccel) +=\n" ^ " \"netaccel.cma netaccel_link.cmo\"" in let netstring = Meta.parse (Filepath.fp "netstring") meta_netstring "netstring" in Printf.printf "archives\n%s\n" (archives_to_string netstring.Meta.Pkg.archives); Printf.printf "append_archives\n%s\n" (archives_to_string netstring.Meta.Pkg.append_archives); assumeEq "netstring description" "Ocamlnet - String processing library" netstring.Meta.Pkg.description; let netstring_byte = Meta.Pkg.get_archive_with_filter (None, netstring) (Libname.of_string "netstring") [Meta.Predicate.Byte] in assumeEq "netstring byte" "archive(byte) = [netstring.cma]\narchive(byte,-nonetaccel) = [netaccel.cma netaccel_link.cmo]" (archives_to_string netstring_byte); let netstring_byte_nonetaccel = Meta.Pkg.get_archive_with_filter (None, netstring) (Libname.of_string "netstring") [Meta.Predicate.Byte; (Meta.Predicate.Unknown "nonetaccel")] in assumeEq "netstring byte nonetaccel" "archive(byte) = [netstring.cma]" (archives_to_string netstring_byte_nonetaccel); let meta_num = "# Specification for the \"num\" library:\n\ requires = \"num.core\"\n\ requires(toploop) = \"num.core,num-top\"\n\ version = \"[distributed with Ocaml]\"\n\ description = \"Arbitrary-precision rational arithmetic\"\n\ package \"core\" (\n\ \ directory = \"^\"\n\ \ version = \"[internal]\"\n\ \ browse_interfaces = \" Unit name: Arith_flags Unit name: Arith_status Unit name: Big_int Unit name: Int_misc Unit name: Nat Unit name: Num Unit name: Ratio \"\n\ \ archive(byte) = \"nums.cma\"\n\ \ archive(native) = \"nums.cmxa\"\n\ \ plugin(byte) = \"nums.cma\"\n\ \ plugin(native) = \"nums.cmxs\"\n\ )\n" in let num = Meta.parse (Filepath.fp "num") meta_num "num" in let num_answer = Meta.Pkg.get_archive_with_filter (None, num) (Libname.of_string "num.core") [Meta.Predicate.Native; Meta.Predicate.Plugin] in assumeEq "num plugin native" "archive(plugin,native) = [nums.cmxs]" (archives_to_string num_answer); let meta_threads = "# Specifications for the \"threads\" library:\n\ version = \"[distributed with Ocaml]\"\n\ description = \"Multi-threading\"\n\ requires(mt,mt_vm) = \"threads.vm\"\n\ requires(mt,mt_posix) = \"threads.posix\"\n\ directory = \"^\"\n\ type_of_threads = \"posix\"\n\ \n\ browse_interfaces = \" Unit name: Condition Unit name: Event Unit name: Mutex Unit name: Thread Unit name: ThreadUnix \"\n\ \n\ warning(-mt) = \"Linking problems may arise because of the missing -thread or -vmthread switch\"\n\ warning(-mt_vm,-mt_posix) = \"Linking problems may arise because of the missing -thread or -vmthread switch\"\n\ \n\ package \"vm\" (\n\ \ # --- Bytecode-only threads:\n\ \ requires = \"unix\"\n\ \ directory = \"+vmthreads\"\n\ \ exists_if = \"threads.cma\"\n\ \ archive(byte,mt,mt_vm) = \"threads.cma\"\n\ \ version = \"[internal]\"\n\ )\n\ \n\ package \"posix\" (\n\ \ # --- POSIX-threads:\n\ \ requires = \"unix\"\n\ \ directory = \"+threads\"\n\ \ exists_if = \"threads.cma\"\n\ \ archive(byte,mt,mt_posix) = \"threads.cma\"\n\ \ archive(native,mt,mt_posix) = \"threads.cmxa\"\n\ \ version = \"[internal]\"\n\ )\n" in let threads = Meta.parse (Filepath.fp "threads") meta_threads "threads" in let threads_answer = Meta.Pkg.get_archive_with_filter (None, threads) (Libname.of_string "threads.posix") [Meta.Predicate.Native; Meta.Predicate.Mt; Meta.Predicate.Mt_posix] in assumeEq "threads native" "archive(native,mt,mt_posix) = [threads.cmxa]" (archives_to_string threads_answer); let meta_ctypes = "\ version = \"0.4\"\n\ description = \"Combinators for binding to C libraries without writing any C.\"\n\ requires = \"unix bigarray str bytes\"\n\ archive(byte) = \"ctypes.cma\"\n\ archive(byte, plugin) = \"ctypes.cma\"\n\ archive(native) = \"ctypes.cmxa\"\n\ archive(native, plugin) = \"ctypes.cmxs\"\n\ exists_if = \"ctypes.cma\"\n\ \n\ package \"top\" (\n\ \ version = \"0.4\"\n\ \ description = \"Toplevel printers for C types\"\n\ \ requires = \"ctypes\"\n\ \ archive(byte) = \"ctypes-top.cma\"\n\ \ archive(byte, plugin) = \"ctypes-top.cma\"\n\ \ archive(native) = \"ctypes-top.cmxa\"\n\ \ archive(native, plugin) = \"ctypes-top.cmxs\"\n\ \ exists_if = \"ctypes-top.cma\"\n\ )\n\ \n\ package \"stubs\" (\n\ \ version = \"0.4\"\n\ \ description = \"Stub generation from C types\"\n\ \ requires = \"ctypes\"\n\ \ archive(byte) = \"cstubs.cma\"\n\ \ archive(byte, plugin) = \"cstubs.cma\"\n\ \ archive(native) = \"cstubs.cmxa\"\n\ \ archive(native, plugin) = \"cstubs.cmxs\"\n\ \ xen_linkopts = \"-lctypes_stubs_xen\"\n\ \ exists_if = \"cstubs.cma\"\n\ )\n\ \n\ package \"foreign\" (\n\ \ version = \"0.4\"\n\ \ description = \"Dynamic linking of C functions\"\n\ \ requires(-mt) = \"ctypes.foreign.unthreaded\"\n\ \ requires(mt) = \"ctypes.foreign.threaded\"\n\ \n\ \ package \"base\" (\n\ \ version = \"0.4\"\n\ \ description = \"Dynamic linking of C functions (base package)\"\n\ \ requires = \"ctypes\"\n\ \ archive(byte) = \"ctypes-foreign-base.cma\"\n\ \ archive(byte, plugin) = \"ctypes-foreign-base.cma\"\n\ \ archive(native) = \"ctypes-foreign-base.cmxa\"\n\ \ archive(native, plugin) = \"ctypes-foreign-base.cmxs\"\n\ \ exists_if = \"ctypes-foreign-base.cma\"\n\ \ )\n\ \n\ \ package \"threaded\" (\n\ \ version = \"0.4\"\n\ \ description = \"Dynamic linking of C functions (for use in threaded programs)\"\n\ \ requires = \"threads ctypes ctypes.foreign.base\"\n\ \ archive(byte) = \"ctypes-foreign-threaded.cma\"\n\ \ archive(byte, plugin) = \"ctypes-foreign-threaded.cma\"\n\ \ archive(native) = \"ctypes-foreign-threaded.cmxa\"\n\ \ archive(native, plugin) = \"ctypes-foreign-threaded.cmxs\"\n\ \ exists_if = \"ctypes-foreign-threaded.cma\"\n\ \ )\n\ \n\ \ package \"unthreaded\" (\n\ \ version = \"0.4\"\n\ \ description = \"Dynamic linking of C functions (for use in unthreaded programs)\"\n\ \ requires = \"ctypes ctypes.foreign.base\"\n\ \ archive(byte) = \"ctypes-foreign-unthreaded.cma\"\n\ \ archive(byte, plugin) = \"ctypes-foreign-unthreaded.cma\"\n\ \ archive(native) = \"ctypes-foreign-unthreaded.cmxa\"\n\ \ archive(native, plugin) = \"ctypes-foreign-unthreaded.cmxs\"\n\ \ exists_if = \"ctypes-foreign-unthreaded.cma\"\n\ \ )\n\ )\n\ " in let ctypes = Meta.parse (Filepath.fp "ctypes") meta_ctypes "ctypes" in Printf.printf "archives\n%s\n" (archives_to_string ctypes.Meta.Pkg.archives); Printf.printf "append_archives\n%s\n" (archives_to_string ctypes.Meta.Pkg.append_archives); if !err > 0 then exit 1 else exit 0 obuild-obuild-v0.1.10/tests/test_path.ml000066400000000000000000000013721327005302600202010ustar00rootroot00000000000000open Obuild open Ext let err = ref 0 let assumeEq testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else (Printf.printf "FAILED %s Expected %s Got %s\n" testname expected got; err := !err + 1) let () = let b = Filepath.fp "src/b" in let b_abc = Hier.of_string "B.Abc" in let b_b_abc = Hier.add_prefix b b_abc in assumeEq "src/b + B.Abc" "src/b" (Filepath.fp_to_string b_b_abc); (* Add_prefix src/b/abc B.Abc.Foo *) let b_abc = Filepath.fp "src/b/abc" in let b_abc_foo = Hier.of_string "B.Abc.Foo" in let b_abc_b_abc_foo = Hier.add_prefix b_abc b_abc_foo in assumeEq "src/b/abc + B.Abc.Foo" "src/b/abc" (Filepath.fp_to_string b_abc_b_abc_foo); if !err > 0 then exit 1 else exit 0 obuild-obuild-v0.1.10/tools/000077500000000000000000000000001327005302600156475ustar00rootroot00000000000000obuild-obuild-v0.1.10/tools/assimilate_oasis.ml000066400000000000000000000001731327005302600215330ustar00rootroot00000000000000(* convert oasis file to obuild file *) open Ext.Filepath open Ext let () = ignore(Filesystem.readFile (fp "_oasis"))