├── .gitignore ├── .merlin ├── .ocamlformat ├── DESIGN.md ├── LICENSE ├── OBUILD_SPEC.md ├── README.md ├── TODO.md ├── bootstrap ├── compat401.ml ├── compat402.ml ├── compat403.ml ├── configure.ml ├── ext ├── filepath.ml ├── filepath.mli ├── filesystem.ml ├── filesystem.mli └── fugue.ml ├── obuild.install ├── obuild.obuild ├── obuild ├── analyze.ml ├── build.ml ├── buildprogs.ml ├── configure.ml ├── dag.ml ├── dagutils.ml ├── dependencies.ml ├── dist.ml ├── exception.ml ├── expr.ml ├── filetype.ml ├── findlibConf.ml ├── gconf.ml ├── generators.ml ├── helper.ml ├── hier.ml ├── libname.ml ├── meta.ml ├── metacache.ml ├── modname.ml ├── pp.ml ├── prepare.ml ├── process.ml ├── prog.ml ├── project.ml ├── scheduler.ml ├── target.ml ├── taskdep.ml ├── types.ml └── utils.ml ├── opam ├── src ├── doc.ml ├── help.ml ├── init.ml ├── install.ml ├── main.ml ├── sdist.ml └── simple.ml ├── tests ├── dependencies │ ├── camlp4 │ │ ├── main.ml │ │ └── test.obuild │ └── ppx_sexp │ │ ├── binprot.ml │ │ ├── both.ml │ │ ├── deriving.ml │ │ ├── hello.ml │ │ ├── hello.obuild │ │ ├── hello_lwt.ml │ │ ├── main.ml │ │ ├── sexp.ml │ │ └── show.ml ├── full │ ├── autogenerated │ │ ├── p3.ml │ │ └── p3.obuild │ ├── autopack │ │ ├── autopack.obuild │ │ └── src │ │ │ ├── a.ml │ │ │ ├── b │ │ │ ├── a.ml │ │ │ └── c.ml │ │ │ └── main.ml │ ├── autopack2 │ │ ├── autopack2.obuild │ │ └── src │ │ │ ├── a.ml │ │ │ ├── b │ │ │ ├── a.ml │ │ │ ├── abc │ │ │ │ └── foo.ml │ │ │ └── c.ml │ │ │ └── main.ml │ ├── complex │ │ ├── complex.obuild │ │ ├── lib │ │ │ ├── imaginary.ml │ │ │ └── math │ │ │ │ ├── accessor.ml │ │ │ │ └── types.ml │ │ ├── lib_real │ │ │ ├── bar.ml │ │ │ └── foo.ml │ │ └── src │ │ │ ├── main.ml │ │ │ └── main1.ml │ ├── complex2 │ │ ├── complex.obuild │ │ ├── lib │ │ │ └── math │ │ │ │ ├── accessor.ml │ │ │ │ └── types.ml │ │ ├── lib2 │ │ │ └── imaginary.ml │ │ ├── lib_real │ │ │ ├── bar.ml │ │ │ └── foo.ml │ │ ├── src │ │ │ └── main1.ml │ │ └── src2 │ │ │ └── main.ml │ ├── dep-uri │ │ ├── p2.ml │ │ └── p2.obuild │ ├── parser │ │ ├── lexer.mll │ │ ├── main.ml │ │ ├── parser.obuild │ │ └── rpncalc.mly │ ├── run │ ├── simple │ │ ├── p1.ml │ │ └── p1.obuild │ ├── test │ │ ├── test.obuild │ │ ├── testX.ml │ │ └── x.ml │ └── with-c │ │ ├── cbits.c │ │ ├── ccall.ml │ │ └── ccall.obuild ├── simple │ ├── deps.build │ ├── deps.ml │ ├── gtk.build │ ├── gtk.ml │ ├── gtk_stubs.c │ ├── hello_world.build │ ├── hello_world.ml │ ├── run │ ├── z.build │ ├── z.ml │ └── z_stubs.c ├── test_dag.ml ├── test_expr.ml ├── test_find.ml └── test_path.ml └── tools └── assimilate_oasis.ml /.gitignore: -------------------------------------------------------------------------------- 1 | *.cmx 2 | *.o 3 | *.cmi 4 | dist 5 | src/obuild 6 | ext/compat.ml 7 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PKG unix 2 | S ext 3 | S src 4 | S obuild 5 | S tools 6 | B dist/** 7 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | if-then-else=fit-or-vertical 2 | break-cases=fit-or-vertical 3 | type-decl=sparse 4 | margin=100 5 | -------------------------------------------------------------------------------- /DESIGN.md: -------------------------------------------------------------------------------- 1 | OBuild Design 2 | ============= 3 | 4 | Genesis 5 | ------- 6 | 7 | Obuild started on a bank holiday after xmas, as an experiment to make the 8 | simplest OCaml build system. The mains goals are to: 9 | 10 | * provide a good user experience. 11 | * provide a building black box, no mocking around generic rules. 12 | * provide features in the highest level possible. 13 | * the cleanest build possible, with by-products hidden from the user. 14 | * provide good defaults, and standardize names as much as possible. 15 | * expose everything that the user of the build system needs in one place. 16 | * be simple to build to prevent any bootstrapping problem. 17 | 18 | One of the main influences was Haskell Cabal, which provides to all Haskellers 19 | a simple way to provide a build system to a project with a single file. This 20 | applies well for the myriad of OCaml options too. 21 | 22 | Simple to build 23 | --------------- 24 | 25 | Obuild is buildable with just the compiler and the compiler standard library. 26 | This make bootstrapping very easy: all you need is the OCaml compiler installed. 27 | 28 | This creates some pain for developers of obuild, as lots of basic functions 29 | available in others libraries need to written again as part of obuild. As the 30 | initial development was done really quickly, some functions are not as 31 | performant (CPU or memory-wise) as they could be. This can be fixed as problem 32 | becomes apparent in scaling. 33 | 34 | Simple to use 35 | ------------- 36 | 37 | Each project is described really simply in a one place, in a user friendly format. 38 | a central .obuild file is used, and provide high level description of your project. 39 | Along with some meta data (name, authors, description, etc), it defines the library, 40 | and\/or executable that the project want to have, from which inputs (source 41 | files, modules). 42 | 43 | All dependencies is fully autogenerated internally and used to recompile only 44 | the necessary bits. 45 | 46 | Along with library and executable, test and benchmark can be defined, so as to 47 | provide a easy way to test or bench some part of your project. It also provides 48 | a standard on how to build and execute tests and benchmarks. Later on, 49 | because of this integration it could provide way to make nice reports (html/javascript) 50 | based on output of benchs and tests. 51 | 52 | Standardizing documentation 53 | --------------------------- 54 | 55 | Providing a standard to generate and install documentation, is one of the sub goals of 56 | obuild. This will go a long way to provide documentation in a centralized place for all 57 | libraries in the ocaml world. 58 | 59 | Internal META parsing 60 | --------------------- 61 | 62 | ocamlfind is the current de-facto standard for the installed package querying. 63 | ocamlfind is usually injected on the command line to ocamlopt,ocamldep,ocamlc 64 | which special flags (-syntax, -package), that ocamlfind will re-write to call 65 | the program with something that the program can understand. All the informations 66 | for this transformation is stored in META files. 67 | 68 | Unfortunately this design prevent META caching, and each time ocamlc/ocamlopt 69 | is used it will reparse the META files. This also causes problem if ocamlfind 70 | does not exists when used as a program, or if the library is not installed when 71 | used as a library. 72 | 73 | Because of those 2 reasons, obuild got a tiny (0.4 KLoC) rewrite of the 74 | necessary part of findlib (3 KLoC). It is not as generic as the original 75 | library. 76 | 77 | Internal Design 78 | --------------- 79 | 80 | By being a single program that knows about how things are supposed to be built, 81 | obuild is in the unique position of caching more and going faster. 82 | 83 | At the moment, there is lots of parsing redundancy for example: 84 | 85 | * a file using campl4, result in camlp4 being called at minimum 2 times as a preprocessor: 86 | one for running ocamldep, and one for running ocamlc. Each time camlp4 is called, 87 | it result in the camlp4 grammar files being reloaded, and camlp4 will output the 88 | same things again. It get worse if you are also compiling other version. 89 | (e.g. a native version, a bytecode version with debug, a native version with 90 | debug, a native version with profiling). This lead to camlp4 called up to 7 91 | times, to produce the exact same thing. 92 | 93 | * without a .mli file, bytecode and native version will also cause ocamlc and ocamlopt 94 | to parse an .ml file twice. This could be made better. 95 | 96 | If the ocaml compiler add support for providing an already parsed .ml 97 | file to ocamlc or ocamlopt, obuild could take advantage of this really easily. 98 | 99 | Also provided compilation re-entrancy and ability to use the ocaml compiler as 100 | a library, obuild could use the compiler as a library. 101 | 102 | Librification 103 | ------------- 104 | 105 | Obuild has been designed to be used as a library eventually. 106 | The code is shifting towards using pure structure and functions, so 107 | that things can be reused. there is some global state, that will be 108 | eventually reduced to provide better control of each parts. 109 | 110 | One of the possible development of this, would be to provide an optional daemon 111 | that monitor file changes, and automatically rebuild on demand without having 112 | to re-analyze the whole project. 113 | 114 | Some other possible scenario is to have other programs use the project file 115 | format, either to provide tools to write them or tools that read them. 116 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013 Vincent Hanquez 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 19 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 20 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 22 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /OBUILD_SPEC.md: -------------------------------------------------------------------------------- 1 | # obuild file specification (DRAFT) 2 | 3 | Here are the fields accepted in obuild files 4 | 5 | The syntax is field (flags): accepted_values 6 | 7 | * field = string 8 | * flags = M (mandatory) 9 | * boolean = true | True | false | False 10 | * accepted_values = comma separated string list | string list | string | boolean 11 | 12 | # Section types 13 | 14 | * executable 15 | * library 16 | * flag 17 | * test 18 | * bench 19 | * example 20 | 21 | # Toplevel fields 22 | 23 | These fields are only accepted in the top level, i.e. not in target 24 | sections, etc. 25 | 26 | * name (M): string 27 | * version (M): string 28 | * obuild-ver (M): 1 29 | * synopsis: 30 | * description: 31 | * licence | license: string: Licence for the project 32 | * licence-file | license-file: string: Filename of the licence in the project directory 33 | * homepage: string: URL of the homepage of the project 34 | * tools: ? 35 | * authors: string list CSV, Info about the authors, separated by commas 36 | * author: string list: Info about the author 37 | * extra-srcs: ? 38 | * configure-script: ? 39 | 40 | # Target fields 41 | 42 | ## Common fields 43 | 44 | * buildable: boolean 45 | * installable: boolean 46 | 47 | ## OCaml target fields 48 | 49 | * builddepends | builddeps | build-deps: string list: ocamlfind library names 50 | * path | srcdir | src-dir: string: sources directory 51 | * preprocessor | pp: string: preprocessor to use 52 | * extra-deps: comma-separated string list: ? 53 | * stdlib: (none | no | standard | core): standard library to link ? 54 | 55 | ## C target fields 56 | 57 | * cdir | c-dir: 58 | * csources | c-sources: 59 | * cflags | c-flags | ccopts | ccopt | c-opts: 60 | * c-libpaths: 61 | * c-libs: 62 | * c-pkgs: 63 | 64 | ## Library only fields 65 | 66 | * sub | subdir | library: NO VALUE (define a new block) 67 | * per: NO VALUE (define a new block) 68 | * modules: 69 | * pack: 70 | * syntax: 71 | * description: 72 | 73 | ## Executable | Example | Test common fields 74 | 75 | * per: NO VALUE (define a new block) 76 | * main | mainis | main-is: string: ml file being the entry point for the executable 77 | 78 | ## Test only fields 79 | 80 | * rundir: 81 | * runopt: 82 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | obuild 2 | ====== 3 | 4 | A parallel, incremental and declarative build system for OCaml. 5 | 6 | Design 7 | ------ 8 | 9 | The goal is to make a very simple build system for users and developers of 10 | OCaml library and programs. 11 | 12 | `obuild` acts as building black box: user declare only what they want to build 13 | and with which sources, and it will be consistently built. The design is based 14 | on Haskell's Cabal, and borrow most of the layout and way of working, 15 | adapting parts where necessary to support OCaml fully. 16 | 17 | There's no way to build things that `obuild` has not been designed to do on 18 | purpose, so that the experience provided is consistent, and all future 19 | improvements to `obuild` will automatically benefit program and libraries using 20 | older versions. Currently unsupported features should be requested on the 21 | Github issue tracker. 22 | 23 | Feature 24 | ------- 25 | 26 | * Incremental & parallel build system. only rebuilding what's necessary. 27 | * Descriptive configuration file. 28 | * Easy for users: no rules to mess about, just describe what you want. 29 | * No building dependency apart from OCaml's stdlib: easy to build 30 | * No tool or binary dependencies apart from ocaml compilers 31 | * OCamlfind-like support integrated for faster compilation 32 | 33 | How to build a project using obuild 34 | ----------------------------------- 35 | 36 | obuild supports a few sub commands: 37 | 38 | ``` 39 | obuild clean 40 | obuild configure 41 | obuild init 42 | obuild build 43 | obuild install 44 | obuild doc 45 | obuild test 46 | obuild sdist 47 | ``` 48 | 49 | * `clean`: make sure there's no build by product in the current project 50 | * `configure`: prepare the project by checking dependencies and making sure 51 | the environment is consistant. If any of the dependencies 52 | changes, the user will have to re-run the configure step. 53 | This also allow the user to change flags that impact the project. 54 | * `build`: build every buildable targets defined by the project. 55 | This will usually build a library or executables. 56 | * `sdist`: create a compressed archive package with the pieces needed to 57 | distribute it via source code. 58 | * `doc`: build the documentation associated with the sources 59 | * `test`: run unit tests 60 | * `install`: install the necessary files of a library or executable 61 | 62 | How to write a project file 63 | --------------------------- 64 | 65 | A project file is a file terminated by the `.obuild` extension. 66 | Only one per project is supported. 67 | 68 | The content is declarative using a simple layout format. 69 | Every normal line needs to be in a "key: value" format. Multiple lines 70 | are supported by indenting (with spaces) the value related to the key. 71 | 72 | ``` 73 | name: myproject 74 | version: 0.0.1 75 | description: 76 | This is my new cool project 77 | . 78 | This is a long description describing properly what the project does. 79 | licence: MyLicense 80 | authors: John Doe 81 | obuild-ver: 1 82 | homepage: http://my.server.com/myproject 83 | ``` 84 | 85 | The different target types: 86 | 87 | * executable: this creates an executable that is going to be installed by default. 88 | * library: create a library that is going to be installed. 89 | * test: create an executable that will not be installed, and will interact with 90 | obuild according to the test_type field. cabal test will run every built tests 91 | in a row. for the exit test_type, the exit code is used to signal error (0 = success, anything else = failure) 92 | * bench: create an executable that will not be installed, and will allow to benchmarks, 93 | some part of the project. This is largely unimplemented and just a placeholder for future development. 94 | * example: create an executable that is not installed, nor compiled by default. you need 95 | to use configure with --enable-examples. This allow to make sure that examples are compiled with 96 | the sources to prevent bitrotting. At a later stage that can be used to generate extra documentation. 97 | 98 | Declaring an executable 99 | ----------------------- 100 | 101 | ``` 102 | executable myexec 103 | main-is: mymain.ml 104 | src-dir: src 105 | build-deps: unix 106 | ``` 107 | 108 | Declaring a library 109 | ------------------- 110 | 111 | ``` 112 | library mylib 113 | modules: Module1, Module2 114 | src-dir: lib 115 | build-deps: mydep1, mydep2 116 | ``` 117 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | This is an unexhaustive and probably inaccurate list of items that need to be 2 | looked at or completed to make obuild even better. It is a good source of idea 3 | for anyone wanting to contribute. 4 | 5 | Projects file 6 | ------------- 7 | 8 | * support if/then/else construct in project file. 9 | * add platform and architecture tests in project file: i.e. "if arch(x86) && ..." 10 | * utf8 in project file (maybe useful ?) 11 | 12 | Better configuring 13 | ------------------ 14 | 15 | * configure storing / build checking of system state (e.g. digest of libraries, pkg-config, etc) 16 | * cache meta in a friendlier format in dist/ after configure. speed up build. 17 | * arbitrary mechanism to poke at the platform and see what it supports. feeding the file autogeneration phase. 18 | * per project and per system configuration file (à la git) 19 | 20 | Perf Improvement 21 | ---------------- 22 | 23 | * use the transitive-edge-reduced dag for checking dependencies. 24 | * remove redundant mtime checks by using a invaliding mtime hashtbl caching mechanism. 25 | * improve change detection with a digest after mtime change. 26 | * improve compilation with .mli by moving the dag pointer of its parents to the compiled interface, not the compiled module. 27 | * ocamldep parallelization & multiples 28 | 29 | Completeness 30 | ----------- 31 | 32 | * add install, and generate META 33 | * generate HTML documentation 34 | * generate cmxs 35 | * generate opam files (.install and .config) 36 | * benchs 37 | 38 | Documenting 39 | ----------- 40 | 41 | * specification for the .obuild file format 42 | * mli files and code documentation 43 | 44 | Misc 45 | ---- 46 | 47 | * init: make it better 48 | * add globs for extras source 49 | * add automatic build-deps scanning/adding (see if possible and default to off probably) 50 | * librarify some part of obuild (Config parsing, meta parsing, opam generation, dependencies analysis, building analysis,...) 51 | * replace Digest by a faster (and more modern) digest module from cryptohash 52 | * better portability (windows) 53 | * add a way to refresh a .mli from scratch. for example obuild generate-mli src/ext.ml will (re-)write src/ext.mli 54 | * 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) 55 | * have test (re-)build themselves when doing obuild test, instead of doing 'obuild build; obuild test'. 56 | * improve command line experience (cmdliner ?) 57 | -------------------------------------------------------------------------------- /bootstrap: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | libs="unix.cma" 4 | 5 | OCAMLC="ocamlc -g -I +unix" 6 | OCAMLVER=$($OCAMLC -version) 7 | echo "$OCAMLVER" 8 | 9 | rm -f ext/compat.ml 10 | if [[ $OCAMLVER < "4.02.0" ]] ; then 11 | echo "Using compat401.ml" 12 | cp -f compat401.ml ext/compat.ml 13 | else 14 | if [[ $OCAMLVER < "4.03.0" ]] ; then 15 | echo "Using compat402.ml" 16 | cp -f compat402.ml ext/compat.ml 17 | else 18 | echo "Using compat403.ml" 19 | cp -f compat403.ml ext/compat.ml 20 | fi 21 | fi 22 | 23 | 24 | extmodules="compat fugue filepath filesystem" 25 | 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" 26 | mainmodules="sdist doc init help install path_generated main" 27 | 28 | set -e 29 | 30 | ######################################################################## 31 | ######################################################################## 32 | ######################################################################## 33 | # build ext 34 | cd ext 35 | rm -f ./*.cmi ./*.cmo ./*.o 36 | FILES=() 37 | for mod in $extmodules 38 | do 39 | echo "COMPILING $mod" 40 | [ -f "${mod}.mli" ] && $OCAMLC -for-pack Ext -c "${mod}.mli" 41 | $OCAMLC -for-pack Ext -c "${mod}.ml" 42 | FILES+=("ext/${mod}.cmo") 43 | done; 44 | cd .. 45 | echo "BUILDING library Ext.cmo" 46 | $OCAMLC -pack -o Ext.cmo -I ext/ "${FILES[@]}" 47 | 48 | ######################################################################## 49 | ######################################################################## 50 | ######################################################################## 51 | # build the library 52 | cd obuild 53 | rm -f ./*.cmi ./*.cmo ./*.o 54 | 55 | FILES=() 56 | for mod in $libmodules 57 | do 58 | echo "COMPILING $mod" 59 | [ -f "${mod}.mli" ] && $OCAMLC -for-pack Obuild -I ../ -c "${mod}.mli" 60 | $OCAMLC -for-pack Obuild -I ../ -c "${mod}.ml" 61 | FILES+=("obuild/${mod}.cmo") 62 | done; 63 | cd .. 64 | echo "BUILDING library Obuild.cmo" 65 | $OCAMLC -pack -o Obuild.cmo -I ext/ "${FILES[@]}" 66 | 67 | # then bootstrap the main executable 68 | # main needs the version number 69 | 70 | cat < src/path_generated.ml 71 | 72 | (* autogenerated file by bootstrap. do not modify *) 73 | 74 | let project_version = "0.0.0" 75 | 76 | EOF 77 | cd src 78 | FILES=() 79 | for mod in $mainmodules 80 | do 81 | echo "COMPILING $mod" 82 | [ -f "${mod}.mli" ] && $OCAMLC -I ../ -c "${mod}.mli" 83 | $OCAMLC -I ../ -c "${mod}.ml" 84 | FILES+=("${mod}.cmo") 85 | done 86 | echo "LINKING obuild.bootstrap" 87 | $OCAMLC -o ../obuild.bootstrap -I ../ ${libs} Ext.cmo Obuild.cmo "${FILES[@]}" 88 | cd .. 89 | 90 | rm -f obuild/*.cmi obuild/*.cmo obuild/*.o 91 | rm -f src/*.cmi src/*.cmo src/*.o 92 | rm -f ./*.cmi ./*.o ./*a ./*.cmo 93 | rm -f src/path_generated.ml 94 | 95 | ######################################################################## 96 | ######################################################################## 97 | ######################################################################## 98 | 99 | # rebuild everything with the bootstraped version 100 | export OCAMLRUNPARAM=b 101 | ./obuild.bootstrap clean 102 | if [ -x "$(command -v ocamlopt)" ]; then 103 | ./obuild.bootstrap configure 104 | time ./obuild.bootstrap build 105 | else 106 | ./obuild.bootstrap configure \ 107 | --disable-executable-native \ 108 | --disable-library-native \ 109 | --disable-library-plugin \ 110 | --enable-executable-bytecode \ 111 | --enable-library-bytecode 112 | time ./obuild.bootstrap build 113 | mv dist/build/obuild/obuild.byte dist/build/obuild/obuild 114 | mv dist/build/obuild-simple/obuild-simple.byte dist/build/obuild-simple/obuild-simple 115 | fi 116 | if [ -x dist/build/obuild/obuild ]; then 117 | rm obuild.bootstrap 118 | fi 119 | -------------------------------------------------------------------------------- /compat401.ml: -------------------------------------------------------------------------------- 1 | let bytes_of_string = String.copy 2 | let bytes_to_string = String.copy 3 | let bytes_make = String.make 4 | let bytes_create = String.create 5 | let bytes_get = String.get 6 | let bytes_set = String.set 7 | let bytes_length = String.length 8 | let bytes_index_from = String.index_from 9 | 10 | let buffer_add_subbytes = Buffer.add_substring 11 | 12 | -------------------------------------------------------------------------------- /compat402.ml: -------------------------------------------------------------------------------- 1 | let bytes_of_string = Bytes.of_string 2 | let bytes_to_string = Bytes.to_string 3 | let bytes_make = Bytes.make 4 | let bytes_create = Bytes.create 5 | let bytes_get = Bytes.get 6 | let bytes_set = Bytes.set 7 | let bytes_length = Bytes.length 8 | let bytes_index_from = Bytes.index_from 9 | 10 | let buffer_add_subbytes = Buffer.add_subbytes 11 | 12 | let string_uncapitalize = String.uncapitalize 13 | let string_capitalize = String.capitalize 14 | let string_lowercase = String.lowercase 15 | let string_uppercase = String.uppercase 16 | let char_uppercase = Char.uppercase 17 | -------------------------------------------------------------------------------- /compat403.ml: -------------------------------------------------------------------------------- 1 | let bytes_of_string = Bytes.of_string 2 | let bytes_to_string = Bytes.to_string 3 | let bytes_make = Bytes.make 4 | let bytes_create = Bytes.create 5 | let bytes_get = Bytes.get 6 | let bytes_set = Bytes.set 7 | let bytes_length = Bytes.length 8 | let bytes_index_from = Bytes.index_from 9 | 10 | let buffer_add_subbytes = Buffer.add_subbytes 11 | 12 | let string_uncapitalize = String.uncapitalize_ascii 13 | let string_capitalize = String.capitalize_ascii 14 | let string_lowercase = String.lowercase_ascii 15 | let string_uppercase = String.uppercase_ascii 16 | let char_uppercase = Char.uppercase_ascii 17 | -------------------------------------------------------------------------------- /configure.ml: -------------------------------------------------------------------------------- 1 | let version = Sys.ocaml_version in 2 | ignore (Sys.command "rm -f ext/compat.ml"); 3 | if version < "4.02.0" then 4 | Sys.command "cp -f compat401.ml ext/compat.ml" 5 | else if version < "4.03.0" then 6 | Sys.command "cp -f compat402.ml ext/compat.ml" 7 | else 8 | Sys.command "cp -f compat403.ml ext/compat.ml" 9 | -------------------------------------------------------------------------------- /ext/filepath.ml: -------------------------------------------------------------------------------- 1 | open Fugue 2 | 3 | exception EmptyFilename 4 | exception InvalidFilename of string 5 | 6 | type filepath = { absolute: bool; filepath : string list } 7 | type filename = { filename : string } 8 | 9 | let is_absolute fp = fp.absolute 10 | let emptyFn = { filename = "" } 11 | let currentDir = { absolute = false; filepath = [] } 12 | 13 | let fp_to_string x = 14 | match x.filepath, x.absolute with 15 | | ([], true) -> "/" 16 | | ([], false) -> "./" 17 | | (l, true) -> "/" ^ String.concat Filename.dir_sep l 18 | | (l, false) -> String.concat Filename.dir_sep l 19 | 20 | let fn_to_string x = x.filename 21 | 22 | let got_dirsep x = 23 | let gotDirsep = ref false in 24 | let dirsepLen = String.length (Filename.dir_sep) in 25 | for i = 0 to String.length x - dirsepLen - 1 26 | do 27 | if String.sub x i dirsepLen = Filename.dir_sep 28 | then gotDirsep := true 29 | done; 30 | !gotDirsep 31 | 32 | (* this only strip the last / if it exists *) 33 | let fp x = 34 | (* TODO fix it properly, however separator is always a single char *) 35 | match string_split Filename.dir_sep.[0] x with 36 | | "" :: p -> 37 | { absolute = true; filepath = List.filter (fun x -> x <> "." && x <> "") p } 38 | | p -> 39 | { absolute = false; filepath = List.filter (fun x -> x <> "." && x <> "") p } 40 | 41 | let fn = function 42 | | "" | "." | ".." -> raise EmptyFilename 43 | | filename when got_dirsep filename -> raise (InvalidFilename filename) 44 | | filename -> { filename } 45 | 46 | let valid_fn x = try let _ = fn x in true with _ -> false 47 | 48 | let () (afp:filepath) (bfp:filepath) = 49 | match (afp.absolute, bfp.absolute) with 50 | | _, true -> failwith "the second argument cannot be an absolute path" 51 | | _ -> { absolute = afp.absolute; filepath = afp.filepath @ bfp.filepath } 52 | 53 | let () (afp:filepath) (bfp:filename) = 54 | { absolute = afp.absolute; filepath = afp.filepath @ [bfp.filename] } 55 | 56 | let (<.>) (afp:filename) ext = fn (afp.filename ^ "." ^ ext) 57 | 58 | let with_optpath mdir (filename : filename) = 59 | let path = 60 | match mdir with 61 | | None -> currentDir 62 | | Some dir -> dir 63 | in 64 | path filename 65 | 66 | let path_length path = List.length path.filepath 67 | 68 | let path_dirname path = { path with filepath = list_init path.filepath } 69 | 70 | let path_basename path = fn (list_last path.filepath) 71 | 72 | let path_parent path = path_dirname (path_dirname path) 73 | 74 | let in_current_dir (x:filename) = fp x.filename 75 | 76 | let chop_extension (x:filename) = fn (Filename.chop_extension (fn_to_string x)) 77 | -------------------------------------------------------------------------------- /ext/filepath.mli: -------------------------------------------------------------------------------- 1 | (** The module [Filepath] defines two types, [filepath] and [filename] 2 | to represent paths and file names in a file system. 3 | 4 | * a [filepath] represent a path in a filesystem. It can be 5 | relative or absolute, and is composed of components. The last 6 | component can correspond to a directory or a file in a 7 | filesystem. Other components correspond to directories. 8 | 9 | * a [filename] encapsulate the name of a file. 10 | *) 11 | 12 | (** Exceptions *) 13 | 14 | (** [EmptyFilename] is raised by [fn] when trying to create a value of 15 | type [filename] out of strings "", "." or ".." *) 16 | exception EmptyFilename 17 | 18 | (** [InvalidFilename fn] is raised by [fn] when trying to create a 19 | value of type [filename] when [fn] contains [Filename.dir_sep]. *) 20 | exception InvalidFilename of string 21 | 22 | (** Types *) 23 | 24 | (** Type representing a path in a filesystem. *) 25 | type filepath 26 | 27 | (** Type representing a file in a filesystem. *) 28 | type filename 29 | 30 | (** Filename guaranteed to point to no valid file. Useful for 31 | initializing structures that have a field of type [filename]. *) 32 | val emptyFn : filename 33 | 34 | (** Filepath pointing to the current working directory. *) 35 | val currentDir : filepath 36 | 37 | (** Functions to convert the above types to and from string. *) 38 | 39 | val fp_to_string : filepath -> string 40 | val fn_to_string : filename -> string 41 | val fp : string -> filepath 42 | val fn : string -> filename 43 | val is_absolute : filepath -> bool 44 | 45 | (** [got_dirsep s] returns [true] if [s] contains [Filename.dir_sep], 46 | i.e. "/" on Unix. *) 47 | val got_dirsep : string -> bool 48 | 49 | (** [valid_fn s] returns [true] if [s] is a valid file name, i.e. not 50 | ".", "..", not containing [Filename.dir_sep]. *) 51 | val valid_fn : string -> bool 52 | 53 | (** [fp1 fp2] concatenate [fp2] to [fp1]. [fp2] cannot be an absolute 54 | path. *) 55 | val ( ) : filepath -> filepath -> filepath 56 | 57 | (** [fp fn] concatenate [fn] to [fp]. *) 58 | val ( ) : filepath -> filename -> filepath 59 | 60 | (** [fn <.> ext] appends the extension [ext] to [fn]. *) 61 | val ( <.> ) : filename -> string -> filename 62 | 63 | (** [with_optpath fp fn] is equivalent to [fp fn] if [fp <> None], 64 | otherwise equivalent to [currentDir fn]. *) 65 | val with_optpath : filepath option -> filename -> filepath 66 | 67 | (** [in_current_dir fn] is equivalent to [currentDir fn]. *) 68 | val in_current_dir : filename -> filepath 69 | 70 | (** [path_length fp] returns the number of components in [fp], 71 | including the last (basename) one. *) 72 | val path_length : filepath -> int 73 | 74 | (** Analogous to [Filename.dirname], but operate on [filepath]s. *) 75 | val path_dirname : filepath -> filepath 76 | 77 | (** Analogous to [Filename.basename], but operate on [filepath]s. *) 78 | val path_basename : filepath -> filename 79 | 80 | (** [path_parent fp] is equivalent to [path_dirname (path_dirname fp)]. *) 81 | val path_parent : filepath -> filepath 82 | 83 | (** Analogous to [Filename.chop_extension], but for [filename]s. *) 84 | val chop_extension : filename -> filename 85 | -------------------------------------------------------------------------------- /ext/filesystem.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Fugue 3 | open Filepath 4 | open Compat 5 | exception UnexpectedFileType of string 6 | exception WriteFailed 7 | 8 | let removeDirContent wpath = 9 | let path = fp_to_string wpath in 10 | let rec rmdir_recursive f path = 11 | let dirhandle = Unix.opendir path in 12 | (try 13 | while true do 14 | let ent = Unix.readdir dirhandle in 15 | if String.length ent > 0 && ent.[0] <> '.' 16 | then 17 | let fent = path ^ Filename.dir_sep ^ ent in 18 | match (Unix.lstat fent).Unix.st_kind with 19 | | Unix.S_DIR -> rmdir_recursive (Unix.rmdir) fent 20 | | Unix.S_REG -> Unix.unlink fent 21 | | _ -> raise (UnexpectedFileType fent) 22 | done; 23 | with End_of_file -> 24 | () 25 | ); 26 | Unix.closedir dirhandle; 27 | f path 28 | in 29 | if Sys.file_exists path 30 | then 31 | rmdir_recursive (const ()) path 32 | 33 | let removeDir path = removeDirContent path; Unix.rmdir (fp_to_string path); () 34 | 35 | let iterate f path = 36 | let entries = Sys.readdir (fp_to_string path) in 37 | Array.fast_sort String.compare entries; 38 | Array.iter (fun ent -> f (fn ent)) entries; 39 | () 40 | 41 | (* list directory entry with a map function included for efficiency *) 42 | let list_dir_pred_map (p : filename -> 'a option) path : 'a list = 43 | let accum = ref [] in 44 | iterate (fun ent -> 45 | match p ent with 46 | | None -> () 47 | | Some e -> accum := e :: !accum 48 | ) path; 49 | !accum 50 | 51 | let list_dir_pred (p : filename -> bool) path : filename list = 52 | list_dir_pred_map (fun e -> if p e then Some e else None) path 53 | 54 | let list_dir = list_dir_pred (const true) 55 | 56 | let list_dir_path_pred p path = 57 | let entries = List.filter p (Array.to_list (Sys.readdir (fp_to_string path))) in 58 | let sorted = List.fast_sort String.compare entries in 59 | List.map (fun ent -> path fn ent) sorted 60 | 61 | let list_dir_path = list_dir_path_pred (const true) 62 | 63 | let getModificationTime path = 64 | try (Unix.stat (fp_to_string path)).Unix.st_mtime 65 | with _ -> 0.0 66 | 67 | let exists path = Sys.file_exists (fp_to_string path) 68 | let is_dir path = 69 | try Sys.is_directory (fp_to_string path) 70 | with _ -> false 71 | 72 | (* create a directory safely. 73 | * 74 | * return false if the directory already exists 75 | * return true if the directory has been created *) 76 | let mkdirSafe path perm = 77 | if Sys.file_exists (fp_to_string path) 78 | then (if Sys.is_directory (fp_to_string path) 79 | then false 80 | else failwith ("directory " ^ (fp_to_string path) ^ " cannot be created: file already exists")) 81 | else (Unix.mkdir (fp_to_string path) perm; true) 82 | 83 | let mkdirSafe_ path perm = 84 | let (_: bool) = mkdirSafe path perm in 85 | () 86 | 87 | let rec mkdirSafeRecursive path perm = 88 | if not (is_dir path) then ( 89 | if path_length path > 1 then ( 90 | mkdirSafeRecursive (path_dirname path) perm; 91 | mkdirSafe_ path perm 92 | ) 93 | ) 94 | 95 | let create_or_empty_dir path = 96 | let created = mkdirSafe path 0o755 in 97 | if not created then 98 | removeDirContent path; 99 | () 100 | 101 | let write_no_partial fd b o l = 102 | let len = ref l in 103 | let ofs = ref o in 104 | while !len > 0 do 105 | let written = Unix.write fd (bytes_of_string b) !ofs !len in 106 | if written = 0 then raise WriteFailed; 107 | ofs := !ofs + written; 108 | len := !len - written 109 | done 110 | 111 | let withfile path openflags perms f = 112 | let fd = Unix.openfile (fp_to_string path) openflags perms in 113 | finally (fun () -> f fd) (fun () -> Unix.close fd) 114 | 115 | let writeFile path s = 116 | withfile path [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o644 (fun fd -> 117 | write_no_partial fd s 0 (String.length s) 118 | ) 119 | 120 | let readFile path = 121 | let buf = Buffer.create 1024 in 122 | let b = bytes_make 1024 ' ' in 123 | withfile path [Unix.O_RDONLY] 0o644 (fun fd -> 124 | let isDone = ref false in 125 | while not !isDone do 126 | let r = Unix.read fd b 0 1024 in 127 | if r > 0 128 | then buffer_add_subbytes buf b 0 r 129 | else isDone := true 130 | done; 131 | Buffer.contents buf 132 | ) 133 | 134 | let copy_file src dst = 135 | mkdirSafeRecursive (path_dirname dst) 0o755; 136 | let s = bytes_make 4096 ' ' in 137 | let srcStat = Unix.stat (fp_to_string src) in 138 | let operm = srcStat.Unix.st_perm in 139 | withfile dst [Unix.O_WRONLY; Unix.O_CREAT] operm (fun fdDst -> 140 | withfile src [Unix.O_RDONLY] 0o644 (fun fdSrc -> 141 | let isDone = ref false in 142 | while not !isDone do 143 | let r = Unix.read fdSrc s 0 4096 in 144 | if r > 0 145 | then write_no_partial fdDst (bytes_to_string s) 0 r 146 | else isDone := true 147 | done 148 | ) 149 | ) 150 | 151 | let copy_to_dir src dst = copy_file src (dst src) 152 | 153 | let copy_many_files srcs dst = List.iter (fun src -> copy_to_dir src dst) srcs 154 | 155 | let rec mktemp_dir_in prefix = 156 | let s = bytes_make 4 ' ' in 157 | let fd = Unix.openfile "/dev/urandom" [Unix.O_RDONLY] 0o640 in 158 | let r = ref 0 in 159 | while !r < 4 do 160 | let n = Unix.read fd s !r (4 - !r) in 161 | if n = 0 162 | then r := 4 (* should never happen, but even if it does, the getpid just provide basic randomness property *) 163 | else r := n + !r 164 | done; 165 | Unix.close fd; 166 | 167 | let s = bytes_to_string s in 168 | 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 169 | let dirName = fp (prefix ^ tmpName) in 170 | let v = mkdirSafe dirName 0o755 in 171 | if v then dirName else mktemp_dir_in prefix 172 | -------------------------------------------------------------------------------- /ext/filesystem.mli: -------------------------------------------------------------------------------- 1 | (** The module [Filesystem] contain helpers to browse and operate on 2 | files and directories of a file system. It uses the abstraction 3 | provided by the module [Filepath]. 4 | *) 5 | 6 | (** Exceptions *) 7 | 8 | (** Raised by [removeDirContent] whenever trying to delete a block or 9 | char device. *) 10 | exception UnexpectedFileType of string 11 | 12 | (** Raised by [write_no_partial]. *) 13 | exception WriteFailed 14 | 15 | (** Removes the contents of a directory. Raises [UnexpectedFileType] 16 | if the directory contain a file representing a block or a 17 | character device. *) 18 | val removeDirContent : Filepath.filepath -> unit 19 | 20 | (** Remove a directory and its content. *) 21 | val removeDir : Filepath.filepath -> unit 22 | 23 | (** [iterate f fp] calls [f] on each filename contained in [fp] 24 | (excluding "." and ".."). Note that a filename can represent 25 | either a file or a directory in the file system. *) 26 | val iterate : (Filepath.filename -> unit) -> Filepath.filepath -> unit 27 | 28 | (** [list_dir_pred_map f fp] applies [f] to each filename contained in 29 | [fp] using [iterate], and returns all elements that have been 30 | obtained when [f] did not return [None]. *) 31 | val list_dir_pred_map : 32 | (Filepath.filename -> 'a option) -> Filepath.filepath -> 'a list 33 | 34 | (** [list_dir_pred pred fp] returns a list of filenames (obtained with 35 | [iterate] that satisfy the predicate [pred]. *) 36 | val list_dir_pred : 37 | (Filepath.filename -> bool) -> Filepath.filepath -> Filepath.filename list 38 | 39 | (** [list_dir fp] returns the files (and directories) under [fp] 40 | (excluding "." and ".."). *) 41 | val list_dir : Filepath.filepath -> Filepath.filename list 42 | 43 | (** [list_dir_path_pred pred fp] returns the paths contained in [fp], 44 | including ".", that satisfy [pred]. *) 45 | val list_dir_path_pred : 46 | (string -> bool) -> Filepath.filepath -> Filepath.filepath list 47 | 48 | (** [list_dir_path fp] returns the paths contained in [fp], including 49 | ".".*) 50 | val list_dir_path : Filepath.filepath -> Filepath.filepath list 51 | 52 | (** Returns the modification time of a filepath, or returns [0.] if 53 | any error occured. *) 54 | val getModificationTime : Filepath.filepath -> float 55 | 56 | (** Analogous of [Sys.file_exists] but for a filepath *) 57 | val exists : Filepath.filepath -> bool 58 | 59 | (** Analogous of [Sys.is_directory] but for a filepath *) 60 | val is_dir : Filepath.filepath -> bool 61 | 62 | (** [mkdirSafe fp perms] creates a directory at [fp] unless a 63 | directory or a file already exists here. Return [false] if a 64 | directory already exists, [true] if the directory has just been 65 | created, and raise an exception [Failure] if a file already exists 66 | at this location. *) 67 | val mkdirSafe : Filepath.filepath -> Unix.file_perm -> bool 68 | 69 | (** Analogous to [ignore (mkdirSafe fp perms). *) 70 | val mkdirSafe_ : Filepath.filepath -> Unix.file_perm -> unit 71 | 72 | (** Recursively create directories with [mkdirSafe_] until the all 73 | directories on the filepath specified as argument exists. *) 74 | val mkdirSafeRecursive : Filepath.filepath -> Unix.file_perm -> unit 75 | 76 | (** [create_or_empty_dir fp] will create a directory at [fp]. If a 77 | directory already exists at [fp], remote its content. *) 78 | val create_or_empty_dir : Filepath.filepath -> unit 79 | 80 | (** [write_no_partial fd buf start len] writes [len] chars of [buf] 81 | starting at [start] in [fd], or raises [WriteFailed] if 82 | impossible. *) 83 | val write_no_partial : Unix.file_descr -> string -> int -> int -> unit 84 | 85 | (** [withfile fp flags perms f] opens the file at [fp] and apply [f] 86 | to the obtained file descriptor. *) 87 | val withfile : 88 | Filepath.filepath -> 89 | Unix.open_flag list -> Unix.file_perm -> (Unix.file_descr -> 'a) -> 'a 90 | 91 | (** Functions for writing/reading to/from a file in a filesystem. *) 92 | 93 | val writeFile : Filepath.filepath -> string -> unit 94 | val readFile : Filepath.filepath -> string 95 | 96 | (** Functions for copying files. *) 97 | 98 | (** [copy_file src dst] will copy file [src] to [dst]. *) 99 | val copy_file : Filepath.filepath -> Filepath.filepath -> unit 100 | 101 | (** [copy_to_dir src dst] fill copy file [src] in directory [dst]. *) 102 | val copy_to_dir : Filepath.filepath -> Filepath.filepath -> unit 103 | 104 | (** [copy_many_files srcs dst] will copy files [srcs] in the directory 105 | [dst]. *) 106 | val copy_many_files : Filepath.filepath list -> Filepath.filepath -> unit 107 | 108 | (** [mktemp_dir_in prefix] creates a temporary directory in the 109 | current working directory, whose name starts with [prefix] but is 110 | otherwise random. *) 111 | val mktemp_dir_in : string -> Filepath.filepath 112 | -------------------------------------------------------------------------------- /ext/fugue.ml: -------------------------------------------------------------------------------- 1 | let finally fct clean_f = 2 | let result = 3 | try fct () 4 | with exn -> 5 | clean_f (); 6 | raise exn 7 | in 8 | clean_f (); 9 | result 10 | 11 | let maybe d f v = 12 | match v with 13 | | None -> d 14 | | Some x -> f x 15 | 16 | let may f v = maybe None (fun x -> Some (f x)) v 17 | let default d v = maybe d (fun x -> x) v 18 | let maybe_unit f v = maybe () f v 19 | let const v _ = v 20 | 21 | let rec maybes_to_list l = 22 | match l with 23 | | [] -> [] 24 | | None :: xs -> maybes_to_list xs 25 | | Some x :: xs -> x :: maybes_to_list xs 26 | 27 | type ('a, 'b) either = Left of 'a | Right of 'b 28 | 29 | let ( $ ) f a = f a 30 | let id x = x 31 | 32 | let char_is_alphanum c = 33 | (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') 34 | 35 | let string_index_pred p s = 36 | let len = String.length s in 37 | let i = ref 0 in 38 | while !i < len && not (p s.[!i]) do 39 | i := !i + 1 40 | done; 41 | if !i == len then 42 | raise Not_found 43 | else 44 | !i 45 | 46 | let rec string_split ?(limit = -1) c s = 47 | let i = try String.index s c with Not_found -> -1 in 48 | let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in 49 | if i = -1 || nlimit = 0 then 50 | [ s ] 51 | else 52 | let a = String.sub s 0 i 53 | and b = String.sub s (i + 1) (String.length s - i - 1) in 54 | a :: string_split ~limit:nlimit c b 55 | 56 | let rec string_split_pred ?(limit = -1) p s = 57 | let i = try string_index_pred p s with Not_found -> -1 in 58 | let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in 59 | if i = -1 || nlimit = 0 then 60 | [ s ] 61 | else 62 | let a = String.sub s 0 i 63 | and b = String.sub s (i + 1) (String.length s - i - 1) in 64 | a :: string_split_pred ~limit:nlimit p b 65 | 66 | let string_startswith prefix x = 67 | let x_l = String.length x and prefix_l = String.length prefix in 68 | prefix_l <= x_l && String.sub x 0 prefix_l = prefix 69 | 70 | let string_endswith suffix x = Filename.check_suffix x suffix 71 | 72 | let string_stripPredicate p str = 73 | let len = String.length str in 74 | let s = ref 0 in 75 | let e = ref (String.length str) in 76 | while !s < len && p str.[!s] do 77 | s := !s + 1 78 | done; 79 | let start = !s in 80 | while !e > start && p str.[!e - 1] do 81 | e := !e - 1 82 | done; 83 | String.sub str start (!e - start) 84 | 85 | let string_stripSpaces = 86 | string_stripPredicate (fun c -> c = ' ' || c = '\t' || c = '\n') 87 | 88 | let string_splitAt pos s = 89 | let len = String.length s in 90 | if pos > len then 91 | invalid_arg "splitAt" 92 | else 93 | (String.sub s 0 pos, String.sub s pos (len - pos)) 94 | 95 | let string_take n s = 96 | let len = String.length s in 97 | if n > len then 98 | invalid_arg "String.take" 99 | else 100 | String.sub s 0 n 101 | 102 | let string_drop n s = 103 | let len = String.length s in 104 | if n > len then 105 | invalid_arg "String.drop" 106 | else 107 | String.sub s n (len - n) 108 | 109 | let string_init n s = 110 | let len = String.length s in 111 | if n > len then 112 | invalid_arg "String.init" 113 | else 114 | String.sub s 0 (len - n) 115 | 116 | let string_all p s = 117 | let len = String.length s in 118 | let rec loop i = 119 | if i = len then true else if not (p s.[i]) then false else loop (i + 1) 120 | in 121 | loop 0 122 | 123 | let string_lines s = string_split '\n' s 124 | 125 | let string_words s = 126 | string_split_pred (fun c -> c = ' ' || c = '\n' || c = '\t') s 127 | 128 | let no_empty emptyVal = List.filter (fun x -> x <> emptyVal) 129 | let string_words_noempty s = no_empty "" (string_words s) 130 | let string_lines_noempty s = no_empty "" (string_lines s) 131 | let list_singleton x = [ x ] 132 | 133 | let rec list_init l = 134 | match l with 135 | | [] -> failwith "init empty list" 136 | | [ _ ] -> [] 137 | | x :: xs -> x :: list_init xs 138 | 139 | let rec list_last l = 140 | match l with 141 | | [] -> failwith "last is empty" 142 | | [ x ] -> x 143 | | _ :: xs -> list_last xs 144 | 145 | let list_remove e list = List.filter (fun x -> x <> e) list 146 | 147 | let list_iteri f list = 148 | let rec loop i l = 149 | match l with 150 | | [] -> () 151 | | x :: xs -> 152 | f i x; 153 | loop (i + 1) xs 154 | in 155 | loop 1 list 156 | 157 | let list_eq_noorder (l1 : 'a list) (l2 : 'a list) : bool = 158 | List.for_all (fun z -> List.mem z l2) l1 159 | 160 | let list_filter_map (f : 'a -> 'b option) (l : 'a list) : 'b list = 161 | let rec loop (z : 'a list) : 'b list = 162 | match z with 163 | | [] -> [] 164 | | x :: xs -> ( 165 | match f x with 166 | | None -> loop xs 167 | | Some y -> y :: loop xs) 168 | in 169 | loop l 170 | 171 | let list_mem_many needles haystack = 172 | let rec loop l = 173 | match l with 174 | | [] -> false 175 | | x :: xs -> if List.mem x needles then true else loop xs 176 | in 177 | loop haystack 178 | 179 | let rec list_uniq l = 180 | match l with 181 | | [] -> [] 182 | | x :: xs -> 183 | if List.mem x xs then 184 | list_uniq xs 185 | else 186 | x :: list_uniq xs 187 | 188 | let rec list_findmap p l = 189 | match l with 190 | | [] -> raise Not_found 191 | | x :: xs -> ( 192 | match p x with 193 | | Some z -> z 194 | | None -> list_findmap p xs) 195 | 196 | let hashtbl_map f h = 197 | let newh = Hashtbl.create (Hashtbl.length h) in 198 | Hashtbl.iter (fun k v -> Hashtbl.add newh k (f v)) h; 199 | newh 200 | 201 | let hashtbl_keys h = Hashtbl.fold (fun k _ l -> k :: l) h [] 202 | 203 | let hashtbl_modify_one f k h = 204 | let v = Hashtbl.find h k in 205 | Hashtbl.replace h k (f v) 206 | 207 | let hashtbl_modify_all f h = 208 | let keys = hashtbl_keys h in 209 | List.iter 210 | (fun k -> 211 | let v = Hashtbl.find h k in 212 | Hashtbl.replace h k (f v)) 213 | keys 214 | 215 | let hashtbl_fromList l = 216 | let h = Hashtbl.create (List.length l) in 217 | List.iter (fun (k, v) -> Hashtbl.add h k v) l; 218 | h 219 | 220 | let hashtbl_toList h = Hashtbl.fold (fun k v l -> (k, v) :: l) h [] 221 | let first f (a, b) = (f a, b) 222 | let second f (a, b) = (a, f b) 223 | 224 | exception ConversionIntFailed of string * string 225 | exception ConversionBoolFailed of string * string 226 | 227 | let user_int_of_string loc s = 228 | try int_of_string s with _ -> raise (ConversionIntFailed (loc, s)) 229 | 230 | let user_bool_of_string loc s = 231 | try bool_of_string s with _ -> raise (ConversionBoolFailed (loc, s)) 232 | 233 | module StringSet = struct 234 | include Set.Make (struct 235 | type t = string 236 | 237 | let compare = compare 238 | end) 239 | 240 | let to_list t = fold (fun elt l -> elt :: l) t [] 241 | end 242 | -------------------------------------------------------------------------------- /obuild.install: -------------------------------------------------------------------------------- 1 | bin: [ 2 | "dist/build/obuild/obuild" 3 | "dist/build/obuild-simple/obuild-simple" 4 | ] 5 | -------------------------------------------------------------------------------- /obuild.obuild: -------------------------------------------------------------------------------- 1 | name: obuild 2 | version: 0.1.11 3 | synopsis: Simple declarative build system for OCaml. 4 | description: 5 | o'build o'build ye source 6 | . 7 | simple declarative build system for OCaml 8 | license: BSD 9 | license-file: LICENSE 10 | authors: Vincent Hanquez , Jerome Maloberti 11 | obuild-ver: 1 12 | configure-script: configure.ml 13 | homepage: http://github.com/ocaml-obuild/obuild 14 | ocaml-extra-args: -w A 15 | extra-srcs: bootstrap 16 | , tests/full/dep-uri/p2.obuild 17 | , tests/full/autogenerated/p3.obuild 18 | , tests/full/autopack/autopack.obuild 19 | , tests/full/with-c/ccall.obuild 20 | , tests/full/with-c/cbits.c 21 | , tests/full/with-c/ccall.ml 22 | , tests/full/dep-uri/p2.ml 23 | , tests/full/autogenerated/p3.ml 24 | , tests/full/autopack/src/main.ml 25 | , tests/full/autopack/src/b/a.ml 26 | , tests/full/autopack/src/b/c.ml 27 | , tests/full/autopack/src/a.ml 28 | , tests/full/parser/main.ml 29 | , tests/full/parser/parser.obuild 30 | , tests/full/parser/rpncalc.mly 31 | , tests/full/parser/lexer.mll 32 | , tests/full/simple/p1.obuild 33 | , tests/full/simple/p1.ml 34 | , tests/full/run 35 | , tests/simple/gtk.ml 36 | , tests/simple/z.ml 37 | , tests/simple/hello_world.ml 38 | , tests/simple/run 39 | , tests/simple/z.build 40 | , tests/simple/gtk.build 41 | , tests/simple/hello_world.build 42 | , tests/simple/z_stubs.c 43 | , tests/simple/gtk_stubs.c 44 | , README.md 45 | , DESIGN.md 46 | , TODO.md 47 | 48 | 49 | library obuild 50 | modules: obuild 51 | build-deps: unix, obuild.ext 52 | library ext 53 | modules: ext 54 | build-deps: unix 55 | 56 | # a comment 57 | executable obuild 58 | main-is: main.ml 59 | src-dir: src 60 | build-deps: unix, obuild 61 | 62 | executable obuild-simple 63 | main-is: simple.ml 64 | src-dir: src 65 | build-deps: unix, obuild 66 | 67 | executable obuild-from-oasis 68 | main-is: assimilate_oasis.ml 69 | src-dir: tools 70 | build-deps: obuild, obuild.ext 71 | installable: false 72 | 73 | test dag 74 | src-dir: tests 75 | main-is: test_dag.ml 76 | build-deps: obuild 77 | 78 | test path 79 | src-dir: tests 80 | main-is: test_path.ml 81 | build-deps: obuild, obuild.ext 82 | 83 | test expr 84 | src-dir: tests 85 | main-is: test_expr.ml 86 | build-deps: obuild, obuild.ext 87 | 88 | test find 89 | src-dir: tests 90 | main-is: test_find.ml 91 | build-deps: obuild, obuild.ext 92 | -------------------------------------------------------------------------------- /obuild/analyze.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext.Compat 4 | open Ext 5 | open Helper 6 | open Printf 7 | open Gconf 8 | open Target 9 | open Dependencies 10 | 11 | exception SublibraryDoesntExists of Libname.t 12 | exception OcamlConfigMissing of string 13 | 14 | (* differentiate if the dependency is system or is internal to the project *) 15 | type dep_type = 16 | | System 17 | | Internal 18 | 19 | type dependency_tag = 20 | | Target of Name.t 21 | | Dependency of Libname.t 22 | 23 | type cpkg_config = { 24 | cpkg_conf_libs : string list; 25 | cpkg_conf_includes : filepath list; 26 | } 27 | 28 | (* this is a read only config of the project for configuring and building. *) 29 | type project_config = { 30 | project_dep_data : (Libname.t, dep_type) Hashtbl.t; 31 | project_pkgdeps_dag : dependency_tag Dag.t; 32 | project_targets_dag : Name.t Dag.t; 33 | project_all_deps : dependency list; 34 | project_file : Project.t; 35 | project_ocamlcfg : (string, string) Hashtbl.t; 36 | project_ocamlmkcfg : (string, string) Hashtbl.t; 37 | project_cpkgs : (string, cpkg_config) Hashtbl.t; 38 | } 39 | 40 | let get_ocaml_config_key_hashtbl key h = 41 | try Hashtbl.find h key with Not_found -> raise (OcamlConfigMissing key) 42 | 43 | let getOcamlConfigKey key = 44 | get_ocaml_config_key_hashtbl key (Prog.getOcamlConfig ()) 45 | 46 | let get_ocaml_config_key key project = 47 | get_ocaml_config_key_hashtbl key project.project_ocamlcfg 48 | 49 | let get_pkg_deps target project = 50 | let pkgs = 51 | Taskdep.linearize project.project_pkgdeps_dag Taskdep.FromParent 52 | [ Target target.target_name ] 53 | in 54 | List.rev 55 | (list_filter_map 56 | (fun pkg -> 57 | match pkg with 58 | | Dependency d -> Some d 59 | | Target _ -> None) 60 | pkgs) 61 | 62 | let get_c_pkg cname project = 63 | try Hashtbl.find project.project_cpkgs cname 64 | with Not_found -> 65 | failwith 66 | (sprintf "C package %s not found in the hashtbl: internal error" cname) 67 | 68 | let is_pkg_internal project pkg = 69 | Hashtbl.find project.project_dep_data pkg = Internal 70 | 71 | let is_pkg_system project pkg = 72 | Hashtbl.find project.project_dep_data pkg = System 73 | 74 | let get_internal_library_deps project target = 75 | let internalDeps = 76 | Dag.getChildren project.project_targets_dag target.target_name 77 | in 78 | list_filter_map 79 | (fun name -> 80 | match name with 81 | | Name.Lib lname -> Some lname 82 | | _ -> None) 83 | internalDeps 84 | 85 | (* all the standard libraries shipped with ocaml, comes *without* META files, so 86 | * we pre-populate the META cache with whatever we need by scanning the 87 | * directory that ocaml use as standard_library (found by running ocamlc -config). 88 | * 89 | * it allows to bootstrap better when ocamlfind has not been yet installed or 90 | * to detect difference of opinions of where the stdlib is, between ocamlfind and ocamlc. 91 | *) 92 | let initializeSystemStdlib ocamlCfg = 93 | let ocaml_ver = Hashtbl.find (Prog.getOcamlConfig ()) "version" in 94 | let stdlibPath = 95 | fp (get_ocaml_config_key_hashtbl "standard_library" ocamlCfg) 96 | in 97 | let stdlibLibs = 98 | Filesystem.list_dir_pred_map 99 | (fun n -> 100 | let ext = Filetype.of_filename n in 101 | if ext = Filetype.FileCMXA || ext = Filetype.FileCMA then 102 | Some n 103 | else 104 | None) 105 | stdlibPath 106 | in 107 | let libs = 108 | list_uniq 109 | $ List.map (fun f -> fn_to_string $ Filepath.chop_extension f) stdlibLibs 110 | in 111 | List.iter 112 | (fun lib -> 113 | (* skip .p library which are just variant of the no .p library *) 114 | if not (string_endswith ".p" lib) then ( 115 | verbose Verbose "initializing standard library : package %s\n" lib; 116 | let libCmxa = lib ^ ".cmxa" in 117 | let libCma = lib ^ ".cma" in 118 | let archives = 119 | (if List.mem (fn libCmxa) stdlibLibs then 120 | [ ([ Meta.Predicate.Native ], libCmxa) ] 121 | else 122 | []) 123 | @ 124 | if List.mem (fn libCma) stdlibLibs then 125 | [ ([ Meta.Predicate.Byte ], libCma) ] 126 | else 127 | [] 128 | in 129 | let meta = 130 | { 131 | (Meta.Pkg.make lib) with 132 | Meta.Pkg.directory = fp_to_string stdlibPath; 133 | Meta.Pkg.requires = [] (* AFAIK this is always empty for stdlibs *); 134 | Meta.Pkg.version = ocaml_ver; 135 | Meta.Pkg.archives; 136 | } 137 | in 138 | Metacache.add lib (stdlibPath fn ("META-" ^ lib), meta))) 139 | libs 140 | 141 | let readOcamlMkConfig filename = 142 | let lines = 143 | Utils.read_file_with 144 | (function 145 | | "" -> None 146 | | s when s.[0] = '#' -> None 147 | | s -> Some s) 148 | (filename ^ "/Makefile.config") 149 | in 150 | let h = Hashtbl.create 32 in 151 | List.iter 152 | (fun l -> 153 | let k, v = Utils.toKVeq l in 154 | Hashtbl.add h (string_lowercase k) (default "" v)) 155 | lines; 156 | h 157 | 158 | (* get all the dependencies required 159 | * and prepare the global bstate.of value *) 160 | let prepare projFile user_flags = 161 | verbose Verbose "analyzing project\n%!"; 162 | let ocamlCfg = Prog.getOcamlConfig () in 163 | let ocamlMkCfg = 164 | readOcamlMkConfig (Hashtbl.find ocamlCfg "standard_library") 165 | in 166 | 167 | let depsTable = Hashtbl.create 16 in 168 | let cpkgsTable = Hashtbl.create 1 in 169 | let depsDag = Dag.init () in 170 | let targetsDag = Dag.init () in 171 | 172 | let missingDeps = ref StringSet.empty in 173 | 174 | initializeSystemStdlib ocamlCfg; 175 | 176 | (* check for findlib / ocaml configuration mismatch *) 177 | let () = 178 | let stdlibPath = 179 | fp (get_ocaml_config_key_hashtbl "standard_library" ocamlCfg) 180 | in 181 | if 182 | not 183 | (List.exists 184 | (fun p -> 185 | string_startswith (fp_to_string p) (fp_to_string stdlibPath) 186 | || string_startswith (fp_to_string stdlibPath) (fp_to_string p)) 187 | (FindlibConf.get_paths ())) 188 | then 189 | Meta.path_warning := true 190 | in 191 | 192 | let allTargets = Project.get_all_buildable_targets projFile user_flags in 193 | 194 | let internalLibs = 195 | List.map 196 | (fun lib -> lib.Project.Library.name.Libname.main_name) 197 | projFile.Project.libs 198 | in 199 | let isInternal lib = List.mem lib.Libname.main_name internalLibs in 200 | 201 | (* establish inter-dependencies in the project. 202 | * only consider internal libraries *) 203 | List.iter 204 | (fun target -> 205 | Dag.addNode target.target_name targetsDag; 206 | List.iter 207 | (fun (dep, _) -> 208 | if isInternal dep then ( 209 | verbose Debug " internal depends: %s\n" (Libname.to_string dep); 210 | Dag.addEdge target.target_name (Name.Lib dep) targetsDag)) 211 | (Target.get_all_builddeps target)) 212 | allTargets; 213 | 214 | let add_missing dep = missingDeps := StringSet.add dep !missingDeps in 215 | 216 | (* load every dependencies META files and at the same time generate the 217 | * graph of inter-dependencies. 218 | * 219 | * This recursively load all dependencies and dependencies's dependencies. 220 | *) 221 | let rec loop dep = 222 | let dataDep () = 223 | if isInternal dep then ( 224 | let iLib = Project.find_lib projFile dep in 225 | let iLibDep = Dependency iLib.Project.Library.name in 226 | Dag.addNode iLibDep depsDag; 227 | List.iter 228 | (fun (reqDep, _) -> 229 | verbose Debug " library %s depends on %s\n" 230 | (Libname.to_string iLib.Project.Library.name) 231 | (Libname.to_string reqDep); 232 | Dag.addEdge iLibDep (Dependency reqDep) depsDag; 233 | loop reqDep) 234 | iLib.Project.Library.target.target_obits.target_builddeps; 235 | Internal) 236 | else 237 | try 238 | let _, meta = Metacache.get dep.Libname.main_name in 239 | Dag.addNode (Dependency dep) depsDag; 240 | let pkg = 241 | try Meta.Pkg.find dep.Libname.subnames meta with 242 | | Not_found -> raise (SublibraryDoesntExists dep) 243 | | Meta.SubpackageNotFound _ -> raise (SublibraryDoesntExists dep) 244 | in 245 | List.iter 246 | (fun (preds, reqDeps) -> 247 | match preds with 248 | | [ Meta.Predicate.Toploop ] -> () 249 | | _ -> 250 | List.iter 251 | (fun reqDep -> 252 | verbose Debug " library %s depends on %s\n" 253 | (Libname.to_string dep) (Libname.to_string reqDep); 254 | Dag.addEdge (Dependency dep) (Dependency reqDep) depsDag; 255 | loop reqDep) 256 | reqDeps) 257 | pkg.Meta.Pkg.requires; 258 | System 259 | with DependencyMissing dep -> 260 | add_missing dep; 261 | System 262 | in 263 | if not (Hashtbl.mem depsTable dep) then 264 | Hashtbl.add depsTable dep (dataDep ()); 265 | () 266 | in 267 | List.iter 268 | (fun target -> 269 | verbose Debug " getting dependencies for target %s\n%!" 270 | (Target.get_target_name target); 271 | let nodeTarget = Target target.target_name in 272 | Dag.addNode nodeTarget depsDag; 273 | (* if a lib, then we insert ourself as dependency for executable or other library *) 274 | let insertEdgeForDependency = 275 | match target.target_name with 276 | | Name.Lib l -> 277 | Dag.addNode (Dependency l) depsDag; 278 | Dag.addEdge (Dependency l) 279 | | _ -> fun _ _ -> () 280 | in 281 | List.iter 282 | (fun (dep, constr) -> 283 | maybe_unit 284 | (fun c -> 285 | let _, pkg = Metacache.get dep.Libname.main_name in 286 | if not (Expr.eval pkg.Meta.Pkg.version c) then 287 | raise 288 | (Dependencies.BuildDepAnalyzeFailed 289 | (Libname.to_string dep ^ " (" ^ pkg.Meta.Pkg.version 290 | ^ ") doesn't match the constraint " ^ Expr.to_string c))) 291 | constr; 292 | Dag.addEdge nodeTarget (Dependency dep) depsDag; 293 | insertEdgeForDependency (Dependency dep) depsDag; 294 | loop dep) 295 | (Target.get_all_builddeps target); 296 | 297 | if not (StringSet.is_empty !missingDeps) then 298 | raise (DependenciesMissing (StringSet.to_list !missingDeps)); 299 | 300 | List.iter 301 | (fun (cpkg, cconstr) -> 302 | let ver = Prog.runPkgConfigVersion cpkg in 303 | (* TODO compare the constraints *) 304 | ignore cconstr; 305 | ignore ver; 306 | let pkgIncludes = List.map fp (Prog.runPkgConfigIncludes cpkg) in 307 | let pkgLibs = Prog.runPkgConfigLibs cpkg in 308 | let pkgConf = 309 | { cpkg_conf_libs = pkgLibs; cpkg_conf_includes = pkgIncludes } 310 | in 311 | Hashtbl.add cpkgsTable cpkg pkgConf) 312 | target.target_cbits.target_cpkgs) 313 | allTargets; 314 | 315 | if gconf.dump_dot then ( 316 | let dotDir = Dist.create_build Dist.Dot in 317 | let path = dotDir fn "dependencies.dot" in 318 | let toString t = 319 | match t with 320 | | Target s -> "target(" ^ Name.to_string s ^ ")" 321 | | Dependency s -> Libname.to_string s 322 | in 323 | let dotContent = Dag.toDot toString "dependencies" true depsDag in 324 | Filesystem.writeFile path dotContent; 325 | 326 | let ipath = dotDir fn "internal-dependencies.dot" in 327 | let dotIContent = 328 | Dag.toDot Name.to_string "internal-dependencies" true targetsDag 329 | in 330 | Filesystem.writeFile ipath dotIContent); 331 | { 332 | project_dep_data = depsTable; 333 | project_pkgdeps_dag = depsDag; 334 | project_targets_dag = targetsDag; 335 | project_all_deps = 336 | List.concat 337 | $ List.map (fun target -> target.target_obits.target_builddeps) allTargets; 338 | project_ocamlcfg = ocamlCfg; 339 | project_ocamlmkcfg = ocamlMkCfg; 340 | project_file = projFile; 341 | project_cpkgs = cpkgsTable; 342 | } 343 | -------------------------------------------------------------------------------- /obuild/buildprogs.ml: -------------------------------------------------------------------------------- 1 | open Types 2 | open Ext 3 | open Ext.Filepath 4 | open Ext.Fugue 5 | open Process 6 | open Prepare 7 | open Gconf 8 | 9 | exception LinkingFailed of string 10 | exception InferFailed of string 11 | 12 | type c_linking_mode = LinkingStatic | LinkingShared 13 | 14 | type linking_mode = LinkingLibrary | LinkingPlugin | LinkingExecutable 15 | 16 | type annotation_mode = AnnotationNone | AnnotationBin | AnnotationText | AnnotationBoth 17 | 18 | type packopt = Hier.t option 19 | 20 | let annotToOpts = function 21 | | AnnotationNone -> [] 22 | | AnnotationBin -> ["-bin-annot"] 23 | | AnnotationText -> ["-annot"] 24 | | AnnotationBoth -> ["-bin-annot";"-annot"] 25 | 26 | let runOcamlCompile dirSpec useThread annotMode buildMode compileOpt packopt pp oflags modhier = 27 | let dstDir = dirSpec.dst_dir in 28 | let entry = Hier.get_file_entry modhier [dirSpec.src_dir] in 29 | let src_file = Hier.get_src_file dirSpec.src_dir entry in 30 | let compileOpt = if buildMode = Interface && compileOpt = WithProf then WithDebug else compileOpt in 31 | Filesystem.mkdirSafeRecursive dstDir 0o755; 32 | let (prog, srcFile, dstFile) = 33 | match buildMode with 34 | | Interface -> 35 | (Prog.getOcamlC () 36 | ,Hier.ml_to_ext src_file Filetype.FileMLI 37 | ,Hier.get_dest_file dstDir Filetype.FileCMI modhier 38 | ) 39 | | Compiled ct -> 40 | let ext = if ct = ByteCode then Filetype.FileCMO else Filetype.FileCMX in 41 | ((if ct = ByteCode then Prog.getOcamlC () else Prog.getOcamlOpt ()) 42 | ,src_file 43 | ,Hier.get_dest_file dstDir ext modhier 44 | ) 45 | in 46 | let args = [prog] 47 | @ (match useThread with 48 | | NoThread -> [] 49 | | WithThread -> ["-thread"]) 50 | @ (Utils.to_include_path_options dirSpec.include_dirs) 51 | @ (match compileOpt with 52 | | Normal -> [] 53 | | WithDebug -> ["-g"] 54 | | WithProf -> ["-p"]) 55 | @ annotToOpts annotMode 56 | @ oflags 57 | @ gconf.ocaml_extra_args 58 | @ Pp.to_params pp 59 | @ maybe [] (fun x -> if buildMode = Compiled Native then [ "-for-pack"; Hier.to_string x ] else []) packopt 60 | @ (if gconf.short_path then [ "-short-paths" ] else []) 61 | @ ["-o"; fp_to_string dstFile ] 62 | @ ["-c"; fp_to_string srcFile ] 63 | in 64 | Process.make args 65 | 66 | let runOcamlPack srcDir dstDir annotMode buildMode packOpt dest modules = 67 | let prog = if buildMode = ByteCode then Prog.getOcamlC () else Prog.getOcamlOpt () in 68 | let ext = if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in 69 | let ext_f = function 70 | | Filetype.FileML -> ext 71 | | Filetype.FileMLI -> Filetype.FileCMI 72 | | _ -> (* It should not happen *) 73 | if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX 74 | in 75 | Filesystem.mkdirSafeRecursive dstDir 0o755; 76 | let args = [prog] 77 | @ maybe [] (fun x -> if buildMode = Native then [ "-for-pack"; Hier.to_string x ] else []) packOpt 78 | @ annotToOpts annotMode 79 | @ [ "-pack"; "-o"; fp_to_string (Hier.get_dest_file dstDir ext dest); ] 80 | @ List.map (fun m -> fp_to_string (Hier.get_dest_file_ext dstDir m ext_f)) modules 81 | in 82 | Process.make args 83 | 84 | let runOcamlInfer srcDir includes pp modname = 85 | let entry = Hier.get_file_entry modname [srcDir] in 86 | let args = [Prog.getOcamlC (); "-i"] 87 | @ Pp.to_params pp 88 | @ (Utils.to_include_path_options includes) 89 | @ [fp_to_string (Hier.get_src_file srcDir entry)] 90 | in 91 | match run args with 92 | | Success (mli, _, _) -> mli 93 | | Process.Failure er -> raise (InferFailed er) 94 | 95 | let o_from_cfile file = file <.> "o" 96 | 97 | let runCCompile project dirSpec cflags file = 98 | let dstDir = dirSpec.dst_dir in 99 | Filesystem.mkdirSafeRecursive dstDir 0o755; 100 | let callCCompiler = string_words_noempty (Analyze.get_ocaml_config_key "bytecomp_c_compiler" project) in 101 | let srcFile = dirSpec.src_dir file in 102 | (* make a .c.o file to avoid collision *) 103 | let dstFile = dirSpec.dst_dir o_from_cfile file in 104 | let args = callCCompiler 105 | @ cflags 106 | @ (Utils.to_include_path_options dirSpec.include_dirs) 107 | @ ["-o"; fp_to_string dstFile] 108 | @ ["-c"; fp_to_string srcFile] 109 | in 110 | Process.make args 111 | 112 | let runAr dest deps = 113 | let args = [ Prog.getAR (); "rc"; fp_to_string dest ] @ List.map fp_to_string deps in 114 | Process.make args 115 | 116 | let runRanlib dest = 117 | Process.make [ Prog.getRanlib (); fp_to_string dest ] 118 | 119 | let runCLinking sharingMode depfiles dest = 120 | let args = if gconf.ocamlmklib then 121 | [ Prog.getOcamlMklib () ] @ (match sharingMode with 122 | | LinkingStatic -> ["-custom"] 123 | | LinkingShared -> []) 124 | @ ["-o"; fp_to_string dest ] 125 | @ List.map fp_to_string depfiles 126 | else (* Not working if system != linux *) 127 | [ Prog.getCC () ] 128 | @ (match sharingMode with 129 | | LinkingStatic -> [] 130 | | LinkingShared -> ["-shared"]) (* TODO: fix this for all system != linux *) 131 | @ ["-o"; fp_to_string dest ] 132 | @ List.map fp_to_string depfiles in 133 | Process.make args 134 | 135 | let runOcamlLinking includeDirs buildMode linkingMode compileType useThread systhread cclibs libs modules dest = 136 | (* create a soft link to a freshly compiled exe, unless a file with the same name already exist *) 137 | let link_maybe linking_mode dest = 138 | let file_or_link_exists fn = try let _ = Unix.lstat fn in true with _ -> false 139 | in 140 | (match linking_mode with 141 | | LinkingPlugin | LinkingLibrary -> () 142 | | LinkingExecutable -> 143 | if not (Gconf.get_target_option "executable-as-obj") then 144 | let real = fp_to_string dest in 145 | let basename = Filename.basename real in 146 | if not (file_or_link_exists basename) 147 | then Unix.symlink real basename) 148 | in 149 | let prog = match buildMode with 150 | | Native -> Prog.getOcamlOpt () 151 | | ByteCode -> Prog.getOcamlC () 152 | in 153 | let ext = if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in 154 | let args = [ prog ] 155 | @ (match useThread with 156 | | NoThreads -> [] 157 | | PosixThread -> ["-thread"] 158 | | VMThread -> ["-vmthread"] 159 | | DefaultThread -> 160 | (if systhread = "true" then ["-thread"] else ["-vmthread"])) 161 | @ (match linkingMode with 162 | | LinkingPlugin -> ["-shared"] 163 | | LinkingLibrary -> ["-a"] 164 | | LinkingExecutable -> if (Gconf.get_target_option "executable-as-obj") then ["-output-obj"] else []) 165 | @ ["-o"; fp_to_string dest] 166 | @ (match compileType with 167 | | Normal -> [] 168 | | WithDebug -> ["-g"] 169 | | WithProf -> ["-p"]) 170 | @ (Utils.to_include_path_options includeDirs) 171 | @ (List.map fp_to_string libs) 172 | @ (List.concat (List.map (fun x -> 173 | [ (match buildMode with 174 | | Native -> "-cclib" 175 | | ByteCode -> if x.[1] = 'L' then "-cclib" else "-dllib") (* Ugly hack but do the job for now *) 176 | ; x ]) cclibs)) 177 | @ (List.map (fun m -> fp_to_string (Hier.get_dest_file currentDir ext m)) modules) 178 | in 179 | let res = Process.make args in 180 | let () = link_maybe linkingMode dest in 181 | res 182 | -------------------------------------------------------------------------------- /obuild/configure.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext.Compat 4 | open Ext 5 | open Helper 6 | open Printf 7 | open Gconf 8 | 9 | exception ConfigChanged of string 10 | exception ToolNotFound of filename 11 | exception ConfigurationMissingKey of string 12 | exception ConfigurationTypeMismatch of string * string * string 13 | exception ConfigureScriptFailed of string 14 | 15 | type flag_action = 16 | | SetFlag of string 17 | | ClearFlag of string 18 | 19 | let getDigestKV () = 20 | let digest = Project.digest () in 21 | [ ("obuild-digest", digest) ] 22 | 23 | let generateMlFile project file flags = 24 | Utils.generateFile file (fun add -> 25 | add "(* autogenerated file by obuild. do not modify *)\n"; 26 | add (sprintf "let project_name = \"%s\"\n" project.Analyze.project_file.Project.name); 27 | add (sprintf "let project_version = \"%s\"\n" project.Analyze.project_file.Project.version); 28 | (* TODO escape name properly *) 29 | List.iter (fun (name, v) -> add (sprintf "let project_flag_%s = %b\n" name v)) flags) 30 | 31 | let generateCFile project file flags = 32 | Utils.generateFile file (fun add -> 33 | add "/* autogenerated file by obuild. do not modify */\n"; 34 | add (sprintf "#define PROJECT_NAME \"%s\"\n" project.Analyze.project_file.Project.name); 35 | add (sprintf "#define PROJECT_VERSION \"%s\"\n" project.Analyze.project_file.Project.version); 36 | (* TODO escape name properly *) 37 | List.iter 38 | (fun (name, v) -> 39 | add (sprintf "#define PROJECT_FLAG_%s %d\n" (string_uppercase name) (if v then 1 else 0))) 40 | flags) 41 | 42 | let makeSetup digestKV project flags = 43 | hashtbl_fromList 44 | (digestKV 45 | @ hashtbl_toList project.Analyze.project_ocamlcfg 46 | @ List.map (fun (opt, v) -> (opt, string_of_bool v)) (Gconf.get_target_options ()) 47 | @ List.map (fun (flagname, flagval) -> ("flag-" ^ flagname, string_of_bool flagval)) flags) 48 | 49 | let sanityCheck () = 50 | let (_ : string) = Prog.getOcamlOpt () in 51 | let (_ : string) = Prog.getOcamlC () in 52 | let (_ : string) = Prog.getOcamlDep () in 53 | () 54 | 55 | let comparekvs reason setup l = 56 | List.iter 57 | (fun (k, v) -> 58 | try 59 | let v' = Hashtbl.find setup k in 60 | if v' <> v then 61 | raise (ConfigChanged reason) 62 | with Not_found -> raise (ConfigChanged reason)) 63 | l 64 | 65 | let comparekvs_hashtbl reason setup l = 66 | Hashtbl.iter 67 | (fun k v -> 68 | try 69 | let v' = Hashtbl.find setup k in 70 | if v' <> v then 71 | raise (ConfigChanged reason) 72 | with Not_found -> raise (ConfigChanged reason)) 73 | l 74 | 75 | let execute_configure_script proj_file = 76 | match proj_file.Project.configure_script with 77 | | None -> () 78 | | Some script -> ( 79 | let args = [ Prog.getOcaml (); fp_to_string script ] in 80 | match Process.run args with 81 | | Process.Success (_, warnings, _) -> print_warnings warnings 82 | | Process.Failure er -> raise (ConfigureScriptFailed er)) 83 | 84 | let create_dist project flags = 85 | verbose Verbose "configuration changed, deleting dist\n%!"; 86 | Filesystem.removeDirContent Dist.build_path; 87 | Dist.remove_dead_links (); 88 | verbose Verbose "auto-generating configuration files\n%!"; 89 | let autogenDir = Dist.create_build Dist.Autogen in 90 | generateMlFile project (autogenDir fn "path_generated.ml") flags; 91 | generateCFile project (autogenDir fn "obuild_macros.h") flags 92 | 93 | let get_assoc name assoc = 94 | try 95 | let v = List.assoc name assoc in 96 | Some v 97 | with Not_found -> None 98 | 99 | let get_flags_value proj_file setup_flags user_flags = 100 | List.map 101 | (fun flag -> 102 | let name = flag.Project.Flag.name in 103 | let def = flag.Project.Flag.default in 104 | let override = ref (get_assoc name setup_flags) in 105 | List.iter 106 | (fun tw -> 107 | match tw with 108 | | ClearFlag s -> if s = name then override := Some false 109 | | SetFlag s -> if s = name then override := Some true) 110 | user_flags; 111 | match (!override, def) with 112 | | None, None -> (name, false) 113 | | None, Some v -> (name, v) 114 | | Some v, _ -> (name, v)) 115 | proj_file.Project.flags 116 | 117 | let check_extra_tools proj_file = 118 | let syspath = Utils.get_system_paths () in 119 | List.iter 120 | (fun tool -> 121 | try 122 | let _ = Utils.find_in_paths syspath tool in 123 | () 124 | with Utils.FileNotFoundInPaths _ -> raise (ToolNotFound tool)) 125 | proj_file.Project.extra_tools 126 | 127 | let get_flags hash = 128 | Hashtbl.fold 129 | (fun k v acc -> 130 | if string_startswith "flag-" k then 131 | (string_drop 5 k, bool_of_string v) :: acc 132 | else 133 | acc) 134 | hash [] 135 | 136 | let bool_of_opt hashtable k = 137 | let get_opt k = 138 | try Hashtbl.find hashtable k with Not_found -> raise (ConfigurationMissingKey k) 139 | in 140 | let v = get_opt k in 141 | try bool_of_string v with Failure _ -> raise (ConfigurationTypeMismatch (k, "bool", v)) 142 | 143 | let set_opts hashtable = 144 | (* load the environment *) 145 | let opts = Gconf.get_target_options_keys () in 146 | List.iter (fun k -> Gconf.set_target_options k (bool_of_opt hashtable k)) opts 147 | 148 | let check_ocaml () = 149 | let ocamlCfg = Prog.getOcamlConfig () in 150 | let ocaml_ver = Hashtbl.find ocamlCfg "version" in 151 | let ver = string_split '.' ocaml_ver in 152 | (match ver with 153 | | major :: minor :: _ -> 154 | if int_of_string major < 4 then gconf.bin_annot <- false; 155 | if int_of_string major > 4 && int_of_string minor > 1 then gconf.short_path <- true 156 | | _ -> gconf.bin_annot <- false); 157 | ocamlCfg 158 | 159 | let run proj_file user_flags user_opts = 160 | Dist.create_maybe (); 161 | let _ = check_ocaml () in 162 | let digestKV = getDigestKV () in 163 | execute_configure_script proj_file; 164 | let configure = try Some (Dist.read_configure ()) with _ -> None in 165 | let configure_flags = 166 | match configure with 167 | | None -> [] 168 | | Some h -> 169 | (* set opts and return the flags *) 170 | Hashtbl.iter 171 | (fun k _ -> 172 | if not (string_startswith "flag-" k) then 173 | Gconf.set_target_options k (bool_of_opt h k)) 174 | h; 175 | get_flags h 176 | in 177 | let flags = get_flags_value proj_file configure_flags user_flags in 178 | verbose Debug " configure flag: [%s]\n" 179 | (Utils.showList "," (fun (n, v) -> n ^ "=" ^ string_of_bool v) flags); 180 | check_extra_tools proj_file; 181 | let project = Analyze.prepare proj_file flags in 182 | (* let's set the user opts before saving the setup file *) 183 | List.iter (fun (o, v) -> Gconf.set_target_options o v) user_opts; 184 | let currentSetup = makeSetup digestKV project flags in 185 | let actualSetup = try Some (Dist.read_setup ()) with _ -> None in 186 | let projectSystemChanged = 187 | match actualSetup with 188 | | None -> true 189 | | Some stp -> ( 190 | (* TODO harcoded for now till we do all the checks. *) 191 | try 192 | comparekvs "setup" stp (hashtbl_toList currentSetup); 193 | (* FORCED should be false *) true 194 | with _ -> true) 195 | in 196 | 197 | if projectSystemChanged then ( 198 | create_dist project flags; 199 | (* write setup file *) 200 | verbose Verbose "Writing new setup\n%!"; 201 | Dist.write_setup currentSetup) 202 | 203 | let check proj_file reconf setup = 204 | let ocamlCfg = check_ocaml () in 205 | let digestKV = getDigestKV () in 206 | (* check if the environment changed. *) 207 | comparekvs_hashtbl "ocaml config" setup ocamlCfg; 208 | (* if the digest of .obuild changed, let's reconfigure *) 209 | let reconfigure = 210 | try 211 | comparekvs "digest" setup digestKV; 212 | false 213 | with e -> if reconf then true else raise e 214 | in 215 | (* user_flags are also restored from setup file *) 216 | let setup_flags = get_flags setup in 217 | let flags = get_flags_value proj_file setup_flags [] in 218 | (* .obuild changed, maybe we should compare a little bit deeper to not retriggerd reconf too often ... *) 219 | if reconfigure then ( 220 | (* let's call configure-script if available, however we don't care about the content of dist/configure *) 221 | execute_configure_script proj_file; 222 | verbose Debug " configure flag: [%s]\n" 223 | (Utils.showList "," (fun (n, v) -> n ^ "=" ^ string_of_bool v) flags); 224 | check_extra_tools proj_file; 225 | let project = Analyze.prepare proj_file flags in 226 | create_dist project flags; 227 | (* write setup file *) 228 | verbose Verbose "Writing new setup\n%!"; 229 | let current_setup = makeSetup digestKV project flags in 230 | Dist.write_setup current_setup); 231 | flags 232 | -------------------------------------------------------------------------------- /obuild/dag.ml: -------------------------------------------------------------------------------- 1 | (* simple bi-directional DAG implementation using shallow link*) 2 | open Printf 3 | open Ext.Compat 4 | 5 | (* represent a node that point shallowly to children and parents *) 6 | type 'a dagnode = 7 | { mutable parents : 'a list 8 | ; mutable children : 'a list 9 | } 10 | 11 | (* TODO add a 'a <-> int table, so that indexing can be done on int instead and 12 | that lists can be replaced by set *) 13 | type 'a t = 14 | { nodes : ('a, 'a dagnode) Hashtbl.t 15 | } 16 | 17 | let init () = { nodes = Hashtbl.create 16 } 18 | 19 | let length dag = Hashtbl.length dag.nodes 20 | 21 | (* Add an directed edge from a to b. 22 | * 23 | * 'a' is the parent of 'b' 24 | * 'b' is the child of 'a' 25 | *) 26 | let addEdge a b dag = 27 | let maNode = try Some (Hashtbl.find dag.nodes a) with Not_found -> None in 28 | let mbNode = try Some (Hashtbl.find dag.nodes b) with Not_found -> None in 29 | (match (maNode, mbNode) with 30 | | None, None -> 31 | Hashtbl.add dag.nodes a { parents = []; children = [b] }; 32 | Hashtbl.add dag.nodes b { parents = [a]; children = [] } 33 | | Some aNode, None -> 34 | if not (List.mem b aNode.children) then aNode.children <- b :: aNode.children; 35 | Hashtbl.add dag.nodes b { parents = [a]; children = [] } 36 | | None, Some bNode -> 37 | if not (List.mem a bNode.children) then bNode.parents <- a :: bNode.parents; 38 | Hashtbl.add dag.nodes a { parents = []; children = [b] } 39 | | Some aNode, Some bNode -> 40 | if not (List.mem b aNode.children) then aNode.children <- b :: aNode.children; 41 | if not (List.mem a bNode.children) then bNode.parents <- a :: bNode.parents 42 | ); 43 | () 44 | 45 | exception DagNode_Not_found 46 | exception DagNode_Already_Exists 47 | 48 | let addNode a dag = 49 | try let _ = Hashtbl.find dag.nodes a in () 50 | with Not_found -> Hashtbl.add dag.nodes a { parents = []; children = [] } 51 | 52 | let addNode_exclusive a dag = 53 | try let _ = Hashtbl.find dag.nodes a in raise DagNode_Already_Exists 54 | with Not_found -> Hashtbl.add dag.nodes a { parents = []; children = [] } 55 | 56 | (* has edge from a to b *) 57 | let hasEdge a b dag = 58 | let maNode = try Some (Hashtbl.find dag.nodes a) with Not_found -> None in 59 | let mbNode = try Some (Hashtbl.find dag.nodes b) with Not_found -> None in 60 | match (maNode, mbNode) with 61 | | Some aNode, Some bNode -> List.mem b aNode.children && List.mem a bNode.parents 62 | | _ -> false 63 | 64 | let delEdge a b dag = 65 | let maNode = try Some (Hashtbl.find dag.nodes a) with Not_found -> None in 66 | let mbNode = try Some (Hashtbl.find dag.nodes b) with Not_found -> None in 67 | (match (maNode, mbNode) with 68 | | Some aNode, Some bNode -> 69 | aNode.children <- List.filter (fun x -> x <> b) aNode.children; 70 | bNode.parents <- List.filter (fun x -> x <> a) bNode.parents 71 | | _ -> () 72 | ) 73 | 74 | let addEdges l dag = 75 | List.iter (fun (n1, n2) -> addEdge n1 n2 dag) l 76 | 77 | (* add edges connected to each other in a list 78 | * n1 -> n2 -> n3 -> ... -> nn 79 | *) 80 | let addEdgesConnected l dag = 81 | let rec loop parent nodes = 82 | match nodes with 83 | | [] -> () 84 | | n::ns -> addEdge parent n dag; loop n ns 85 | in 86 | match l with 87 | | [] -> () 88 | | x::[] -> addNode x dag 89 | | x::l -> loop x l 90 | 91 | 92 | (* add children edges with p the parent 93 | * p -> l[1], p -> l[2], ..., p -> l[n] 94 | *) 95 | let addChildrenEdges p l dag = 96 | List.iter (fun x -> addEdge p x dag) l 97 | 98 | let existsNode a dag = Hashtbl.mem dag.nodes a 99 | 100 | let getLeaves dag = 101 | Hashtbl.fold (fun k v acc -> if v.children = [] then k::acc else acc) dag.nodes [] 102 | 103 | let getRoots dag = 104 | Hashtbl.fold (fun k v acc -> if v.parents = [] then k::acc else acc) dag.nodes [] 105 | 106 | let getNode dag a = try Hashtbl.find dag.nodes a 107 | with Not_found -> raise DagNode_Not_found 108 | let getNodes dag = Hashtbl.fold (fun k _ acc -> k :: acc) dag.nodes [] 109 | 110 | let getChildren dag a = (getNode dag a).children 111 | 112 | let getParents dag a = (getNode dag a).parents 113 | 114 | let rec getChildren_full dag a = 115 | let children = getChildren dag a in 116 | children @ List.concat (List.map (getChildren_full dag) children) 117 | 118 | let isChildren dag a b = List.mem b (getChildren dag a) 119 | 120 | let rec isChildren_full dag a b = 121 | let children = getChildren dag a in 122 | (* either it's present here, or in one of the kiddy *) 123 | List.mem b children || 124 | List.fold_left (fun acc child -> 125 | acc || isChildren_full dag child b 126 | ) false children 127 | 128 | let subset dag roots = 129 | let subdag = init () in 130 | let rec loop node = 131 | addNode node subdag; 132 | let children = getChildren dag node in 133 | List.iter (fun child -> addEdge node child subdag; loop child) children 134 | in 135 | List.iter (fun root -> loop root) roots; 136 | subdag 137 | 138 | let copy dag = 139 | let nodes = Hashtbl.fold (fun k _ acc -> k :: acc) dag.nodes [] in 140 | let dag2 = init () in 141 | let copy_node node = 142 | addNode node dag2; 143 | let children = getChildren dag node in 144 | addChildrenEdges node children dag2 145 | in 146 | List.iter (fun node -> copy_node node) nodes; 147 | dag2 148 | 149 | let merge dest src = 150 | let nodes = Hashtbl.fold (fun k _ acc -> k :: acc) src.nodes [] in 151 | let dups = ref [] in 152 | List.iter (fun node -> if existsNode node dest then dups := node :: !dups) nodes; 153 | let copy_node node = 154 | addNode node dest; 155 | let children = getChildren src node in 156 | addChildrenEdges node children dest 157 | in 158 | List.iter (fun node -> copy_node node) nodes; 159 | !dups 160 | 161 | (* o(v^3) use with care *) 162 | let transitive_reduction dag = 163 | let reducedDag = copy dag in 164 | (* this is sub optimal, as we re-lookup nodes everytimes in hasEdge AND delEdge. 165 | * would go away automatically when having the lookup dict with sets. *) 166 | let nodes = Hashtbl.fold (fun k _ acc -> k :: acc) dag.nodes [] in 167 | List.iter (fun x -> 168 | List.iter (fun y -> 169 | List.iter (fun z -> 170 | if hasEdge x y dag && hasEdge y z dag 171 | then delEdge x z reducedDag 172 | else () 173 | ) nodes 174 | ) nodes 175 | ) nodes; 176 | reducedDag 177 | 178 | (* this is for debugging the DAG. 179 | * dump the dag links and node in a textual format *) 180 | let dump a_to_string dag = 181 | let all = getNodes dag in 182 | List.iter (fun n -> 183 | printf "%s:\n" (a_to_string n); 184 | printf " | parents = %s\n" (String.concat ", " (List.map a_to_string (getParents dag n))); 185 | printf " | children = %s\n" (String.concat ", " (List.map a_to_string (getChildren dag n))) 186 | ) all 187 | 188 | (* it's useful to be able to visualize the DAG with the excellent dot 189 | *) 190 | let toDot a_to_string name fromLeaf dag = 191 | let buf = Buffer.create 1024 in 192 | let nodes = getNodes dag in 193 | let dotIndex = Hashtbl.create (List.length nodes) in 194 | let append = Buffer.add_string buf in 195 | let sanitizeName = bytes_of_string name in 196 | for i = 0 to String.length name - 1 197 | do 198 | if (bytes_get sanitizeName i) = '-' 199 | then bytes_set sanitizeName i '_' 200 | done; 201 | 202 | append ("digraph " ^ (bytes_to_string sanitizeName) ^ " {\n"); 203 | 204 | let list_iteri f list = 205 | let rec loop i l = 206 | match l with 207 | | [] -> () 208 | | x::xs -> f i x; loop (i+1) xs 209 | in 210 | loop 1 list 211 | in 212 | 213 | list_iteri (fun i n -> 214 | Hashtbl.add dotIndex n i; 215 | append (sprintf " %d [label = \"%s\"];\n" i (a_to_string n)); 216 | ) nodes; 217 | 218 | List.iter (fun n -> 219 | let i = Hashtbl.find dotIndex n in 220 | List.iter (fun child -> 221 | let ci = Hashtbl.find dotIndex child in 222 | append (sprintf " %d -> %d;\n" i ci) 223 | ) ((if fromLeaf then getParents else getChildren) dag n) 224 | ) nodes; 225 | 226 | append "}\n"; 227 | Buffer.contents buf 228 | -------------------------------------------------------------------------------- /obuild/dagutils.ml: -------------------------------------------------------------------------------- 1 | let iter f dag = 2 | let tdep = Taskdep.init dag in 3 | while not (Taskdep.is_complete tdep) do 4 | match Taskdep.get_next tdep with 5 | | None -> failwith "taskdep dag next didn't work" 6 | | Some (_,task) -> f task; Taskdep.mark_done tdep task 7 | done 8 | 9 | let iteri f dag = 10 | let tdep = Taskdep.init dag in 11 | while not (Taskdep.is_complete tdep) do 12 | match Taskdep.get_next tdep with 13 | | None -> failwith "taskdep dag next didn't work" 14 | | Some (idx,task) -> f idx task; Taskdep.mark_done tdep task 15 | done 16 | 17 | let linearize dag = 18 | let tdep = Taskdep.init dag in 19 | let rec loop () = 20 | if Taskdep.is_complete tdep 21 | then [] 22 | else ( 23 | match Taskdep.get_next tdep with 24 | | None -> failwith "taskdep dag next didn't work" 25 | | Some (_,task) -> Taskdep.mark_done tdep task; task :: loop () 26 | ) 27 | in 28 | loop () 29 | 30 | -------------------------------------------------------------------------------- /obuild/dependencies.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext.Compat 4 | 5 | exception BuildDepAnalyzeFailed of string 6 | exception BuildCDepAnalyzeFailed of string 7 | 8 | exception DependencyMissing of string 9 | exception DependenciesMissing of string list 10 | exception DependencyFailedParsing of string 11 | 12 | type dependency = Libname.t * (Expr.t option) 13 | 14 | type cdependency = string * (Expr.t option) 15 | 16 | type dep_opt = 17 | { dep_includes: filepath list 18 | ; dep_pp : Pp.t 19 | } 20 | 21 | let parse_output_KsemiVs onNonKV mapFstTy mapSndTys out = 22 | List.map (fun (k, mv) -> 23 | match mv with 24 | | None -> onNonKV k 25 | | Some v -> (mapFstTy k, List.map mapSndTys (string_words_noempty v)) 26 | ) (List.map Utils.toKV (string_lines_noempty out)) 27 | 28 | (* return the (modules list) dependency for a specific file *) 29 | let runOcamldep dopt srcFile = 30 | let wrap_module_safe f = 31 | try Modname.wrap f 32 | with _ -> raise (BuildDepAnalyzeFailed ("ocamldep returned a bad module name " ^ f)) 33 | in 34 | let fileType = Filetype.of_filepath srcFile in 35 | let baseFile = fp_to_string srcFile in 36 | let files = if fileType = Filetype.FileML then [baseFile; baseFile ^ "i"] 37 | else [baseFile] in 38 | let args = [Prog.getOcamlDep ()] 39 | @ (Utils.to_include_path_options dopt.dep_includes) 40 | @ (Pp.to_params dopt.dep_pp) 41 | @ ["-modules"] @ files in 42 | match Process.run args with 43 | | Process.Failure er -> raise (BuildDepAnalyzeFailed er) 44 | | Process.Success (out,_,_) -> 45 | List.map snd (parse_output_KsemiVs 46 | (fun _ -> raise (BuildDepAnalyzeFailed ("assumption failed: " ^ out))) 47 | fp wrap_module_safe out 48 | ) 49 | 50 | (* TODO 51 | * gcc escape spaces in filename with a \, tweak strings_words_noempty 52 | * to take that in consideration. 53 | *) 54 | let joinLines s = 55 | let s = bytes_of_string s in 56 | let s_end = bytes_length s in 57 | let rec replace start = 58 | try 59 | let index = bytes_index_from s start '\\' in 60 | if index < s_end - 1 then 61 | if (bytes_get s (index + 1)) = '\n' then begin 62 | bytes_set s index ' '; 63 | bytes_set s (index + 1) ' '; 64 | replace (index + 2) 65 | end 66 | else 67 | replace (index + 1) 68 | else 69 | s 70 | with Not_found -> s 71 | in 72 | bytes_to_string (replace 0) 73 | 74 | let runCCdep srcDir files : (filename * filepath list) list = 75 | let args = [Prog.getCC (); "-MM"] @ List.map (fun fn -> fp_to_string (srcDir fn)) files in 76 | match Process.run args with 77 | | Process.Failure err -> raise (BuildCDepAnalyzeFailed err) 78 | | Process.Success (out,_,_) -> 79 | parse_output_KsemiVs 80 | (fun _ -> raise (BuildCDepAnalyzeFailed "missing semicolon in gcc dependency output")) 81 | fn fp (joinLines out) 82 | 83 | -------------------------------------------------------------------------------- /obuild/dist.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext 4 | 5 | type t = Autogen | Dot | Target of Target.Name.t 6 | 7 | let to_string = function 8 | | Autogen -> "autogen" 9 | | Dot -> "dot" 10 | | Target n -> "target(" ^ Target.Name.to_string n ^ ")" 11 | 12 | let to_filename = function 13 | | Target tn -> Target.Name.to_dirname tn 14 | | Dot -> fn ("dot") 15 | | Autogen -> fn ("autogen") 16 | 17 | exception NotADirectory 18 | exception MissingDestinationDirectory of t 19 | exception DoesntExist 20 | exception FileDoesntExist of string 21 | 22 | let path = ref (fp "dist") 23 | 24 | let set_path p = path := p 25 | let get_path () = !path 26 | 27 | let setup_path = get_path () fn "setup" 28 | let configure_path = get_path () fn "configure" 29 | let build_path = get_path () fn "build" 30 | 31 | let check_exn f = 32 | if Filesystem.exists (get_path ()) then 33 | (if Sys.is_directory $ fp_to_string (get_path ()) then () 34 | else raise NotADirectory) 35 | else 36 | f () 37 | 38 | let exist () = check_exn (fun () -> raise DoesntExist) 39 | let create_maybe () = check_exn (fun () -> let _ = Filesystem.mkdirSafe (get_path ()) 0o755 in ()) 40 | 41 | let get_build () = get_path () fn "build" 42 | 43 | let get_build_path buildtype = 44 | get_build () (to_filename buildtype) 45 | 46 | let get_build_exn buildtype = 47 | let dist = get_build_path buildtype in 48 | if not (Filesystem.is_dir dist) then 49 | raise (MissingDestinationDirectory buildtype) 50 | else 51 | dist 52 | 53 | let create_build buildtype = 54 | let _ = Filesystem.mkdirSafe (get_build ()) 0o755 in 55 | let dest = get_build_path buildtype in 56 | let _ = Filesystem.mkdirSafe dest 0o755 in 57 | dest 58 | 59 | let read_dist_file path = 60 | try 61 | let content = Filesystem.readFile path in 62 | hashtbl_fromList (List.map (fun l -> second (default "") $ Utils.toKV l) $ string_split '\n' content) 63 | with _ -> raise (FileDoesntExist (fp_to_string path)) 64 | 65 | let read_setup () = read_dist_file setup_path 66 | let read_configure () = read_dist_file configure_path 67 | 68 | let write_setup setup = 69 | let kv (k,v) = k ^ ": " ^ v in 70 | Filesystem.writeFile setup_path (String.concat "\n" $ List.map kv (hashtbl_toList setup)) 71 | 72 | let remove_dead_links () = 73 | let files = Sys.readdir "." in 74 | let build_path = fp_to_string (get_build ()) in 75 | Array.iter (fun fn -> try 76 | let l = Unix.readlink fn in 77 | if (string_startswith build_path l) then 78 | Sys.remove fn 79 | with _ -> ()) files 80 | -------------------------------------------------------------------------------- /obuild/exception.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Helper 3 | open Ext.Filepath 4 | 5 | (* TODO normalize exit code *) 6 | 7 | let show exn = 8 | let error fmt = eprintf ("%serror%s: " ^^ fmt) (color_white ()) (color_white ()) in 9 | match exn with 10 | | Arg.Bad err -> eprintf "%s\n" err; exit 2 11 | | Arg.Help h -> eprintf "%s\n" h; exit 0 12 | (* project file related *) 13 | | Project.NoConfFile -> error "couldn't find obuild file\n"; exit 3 14 | | Project.MultipleConfFiles -> error "multiples obuild files found\n"; exit 3 15 | | Project.FileDoesntExist (t,f) -> 16 | error "project is referencing in %s, a file %s that cannot be found\n" 17 | (Target.get_target_name t) (fn_to_string f); 18 | exit 3 19 | | Project.ModuleDoesntExist (t,m) -> 20 | error "project is referencing in '%s', a module %s that cannot be found\n" 21 | (Target.get_target_name t) (Hier.to_string m); 22 | exit 3 23 | | Project.ModuleListEmpty l -> 24 | error "library %s doesn't have any modules defined.\n" (Libname.to_string l); 25 | exit 3 26 | | Project.InvalidConfFile c -> 27 | error "configuration file appears invalid: %s\n" c; exit 3 28 | | Project.BlockSectionAsValue s -> 29 | error "trying to define a section %s using parameter syntax:\n" s; 30 | eprintf " spurious colon between section definition and section name\n"; 31 | exit 3 32 | | Project.BadOcamlVersion (ver,c) -> 33 | error "wrong ocaml version: actual %s expected %s\n" ver (Expr.to_string c); 34 | exit 3 35 | | Expr.CannotParseConstraints (builddep, s) -> 36 | error "cannot parse constraints for build dependency '%s': %s\n" builddep s; 37 | exit 3 38 | (* dist directory related *) 39 | | Dist.NotADirectory -> error "dist is not a directory\n"; exit 4 40 | | Dist.DoesntExist -> error "run 'obuild configure' first\n"; exit 4 41 | | Dist.MissingDestinationDirectory dir -> error "missing destination directory: %s\n" (Dist.to_string dir); exit 4 42 | (* types stuff *) 43 | | Target.TargetNameNoType s -> 44 | error "Unknown target '%s' with no prefix:\n" s; 45 | error " targets need to start by one of lib-,exe-,bench-,test-,example-\n"; 46 | exit 4 47 | | Target.TargetUnknownType (p,s) -> 48 | error "unknown type prefix '%s' in '%s':\n" p s; 49 | error " targets need to start by one of lib-,exe-,bench-,test-,example-\n"; 50 | exit 4 51 | | Target.TargetNotRecognized s -> 52 | error "Unknown target specified '%s'\n" s; 53 | exit 4 54 | (* reconfigure *) 55 | | Configure.ConfigChanged r -> 56 | (match r with 57 | | "digest" -> error "project file changed. run 'obuild configure' again\n"; exit 4 58 | | _ -> error "config changed (reason=%s). run 'obuild configure' again\n" r; exit 4 59 | ) 60 | | Configure.ConfigurationMissingKey k -> 61 | error "cannot find key %s in setup. run 'obuild configure' again\n" k; exit 4 62 | | Configure.ConfigurationTypeMismatch (k,t,v) -> 63 | error "%s type mismatch (got '%s') in setup key %s. run 'obuild configure' again\n" t v k; exit 4 64 | | Meta.MetaParseError (fp,err) -> 65 | error "unexpected parse error '%s' in meta file %s\n" err (fp_to_string fp); exit 4 66 | | Meta.ArchiveNotFound (path, dep, preds) -> 67 | 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 68 | | Analyze.SublibraryDoesntExists dep -> 69 | error "dependency %s not found\n" (Libname.to_string dep); exit 4 70 | (* build related failure *) 71 | | Prepare.Module.DependsItself m -> error "cyclic dependency module detected in module %s\n" (Hier.to_string m); exit 5 72 | | Prepare.Module.NotFound (paths,m) -> 73 | error "module not found %s - search paths:\n" (Hier.to_string m); 74 | List.iter (fun path -> eprintf "\t%s\n" (fp_to_string path)) paths; 75 | exit 5 76 | | Prepare.Module.DependenciesProblem l -> 77 | error "cyclic dependency detected. cannot infer dependencies between modules:\n"; 78 | eprintf "\t%s\n" (Utils.showList ", " Hier.to_string l); 79 | exit 5 80 | | Build.CompilationFailed e -> eprintf "\n%s\n%!" e; exit 6 81 | | Build.CCompilationFailed e -> eprintf "\n%s\n%!" e; exit 6 82 | | Buildprogs.LinkingFailed e -> eprintf "\n%s\n%!" e; exit 7 83 | | Dependencies.BuildDepAnalyzeFailed e -> eprintf "\n%s\n%!" e; exit 8 84 | | Dependencies.DependenciesMissing missing -> 85 | begin match List.length missing with 86 | | 0 -> assert false 87 | | 1 -> error "missing dependency '%s'\n" (List.hd missing); exit 9 88 | | _ -> eprintf "missing dependencies:\n%s\n" (Utils.showList "\n" (fun x -> x) missing); exit 9 89 | end 90 | (* others exception *) 91 | | Unix.Unix_error (err, fname, params) -> 92 | error "unexpected unix error: \"%s\" during %s(%s)\n" (Unix.error_message err) fname params; 93 | exit 20 94 | | Ext.Filepath.InvalidFilename f -> 95 | error "the filename \"%s\" is not valid, it contains a directory separator\n" f; 96 | exit 30 97 | | Utils.FileNotFoundInPaths (ds,f) -> 98 | error "File %s not found in directories %s\n" (fn_to_string f) 99 | (Utils.showList "; " fp_to_string ds); 100 | exit 40 101 | | Exit -> () 102 | | e -> eprintf "uncaught exception\n"; raise e 103 | -------------------------------------------------------------------------------- /obuild/expr.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | 3 | exception UnknownSymbol of (string * string) 4 | exception UnknownExpression of string 5 | exception ExpressionEmpty 6 | exception UnbalancedParenthesis 7 | exception MalformedExpression 8 | exception InvalidDependencyName of string 9 | exception CannotParseConstraints of (string * string) 10 | 11 | type version = string 12 | 13 | module Token = struct 14 | type t = 15 | | VER of string (* version *) 16 | | ID of string (* ident *) 17 | | LPAREN 18 | | RPAREN 19 | | AND 20 | | OR 21 | | NOT 22 | | EQ 23 | | NE 24 | | GT 25 | | LT 26 | | GE 27 | | LE 28 | 29 | let to_string = function 30 | | VER v -> v 31 | | ID s -> s 32 | | LPAREN -> "(" 33 | | RPAREN -> ")" 34 | | AND -> "&" 35 | | OR -> "|" 36 | | NOT -> "!" 37 | | EQ -> "==" 38 | | NE -> "!=" 39 | | GT -> ">" 40 | | LT -> "<" 41 | | GE -> ">=" 42 | | LE -> "<=" 43 | 44 | let of_string symbol s = match symbol with 45 | | "&&" | "&" -> AND 46 | | "||" | "|" -> OR 47 | | ">" -> GT 48 | | "<" -> LT 49 | | ">=" -> GE 50 | | "<=" -> LE 51 | | "==" | "=" -> EQ 52 | | "!=" | "/=" -> NE 53 | | "!" -> NOT 54 | | _ -> raise (UnknownSymbol (symbol,s)) 55 | 56 | let process_one_char c next = 57 | match (c,next) with 58 | | '(', _ -> LPAREN 59 | | ')', _ -> RPAREN 60 | | '!', Some '=' -> raise Not_found (* should be parsed as a string != *) 61 | | '!', _ -> NOT 62 | | _ -> raise Not_found 63 | 64 | (* valid char per types *) 65 | let is_symbol_char c = try let _ = String.index "&/|!+=><()" c in true with _ -> false 66 | let is_ident_char c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || 67 | (c >= '0' && c <= '9') || c == '_' || c == '.' || c == '-' 68 | let is_version_char c = (c >= '0' && c <= '9') || c = '.' || c = '*' 69 | 70 | let lexer s = 71 | let len = String.length s in 72 | let while_pred pred o = 73 | let i = ref o in 74 | while !i < len && pred s.[!i] do i := !i + 1 done; 75 | (String.sub s o (!i-o), !i) 76 | in 77 | (* Per type lexer *) 78 | let eat_symbol o = 79 | let (tok,no) = 80 | let next = if o+1 < len then Some (s.[o+1]) else None in 81 | try let tok = process_one_char s.[o] next in (tok,o+1) 82 | with Not_found -> 83 | let (p, no) = while_pred is_symbol_char o in 84 | let tok = of_string p s in 85 | (tok,no) 86 | in (tok,no) 87 | in 88 | let eat_version o = while_pred is_version_char o in 89 | let eat_ident o = while_pred is_ident_char o in 90 | (* main lexing loop *) 91 | let rec loop o = 92 | if o >= len then [] 93 | else begin 94 | (* TODO skip chunk of space in one go *) 95 | if s.[o] == ' ' || s.[o] == '\t' then ( 96 | loop (o+1) 97 | ) else if is_symbol_char s.[o] then ( 98 | let (sym, no) = eat_symbol o in sym :: loop no 99 | ) else if (s.[o] >= 'a' && s.[o] <= 'z') || 100 | (s.[o] >= 'A' && s.[o] <= 'Z') then ( 101 | let (id, no) = eat_ident o in ID id :: loop no 102 | ) else if is_version_char s.[o] then ( 103 | let (ver, no) = eat_version o in VER ver :: loop no 104 | ) else 105 | failwith (Printf.sprintf "unknown character in expression '%c'" s.[o]) 106 | end 107 | in 108 | loop 0 109 | end 110 | 111 | type t = 112 | | And of t * t 113 | | Or of t * t 114 | | Not of t 115 | | Paren of t 116 | | Eq of version 117 | | Le of version 118 | | Lt of version 119 | | Ge of version 120 | | Gt of version 121 | | Ne of version 122 | 123 | let compare_version v1 v2 = 124 | let skip i p s e = 125 | let rec loop i = if i = e then i else if (p s.[i]) then loop (i + 1) else i 126 | in loop i 127 | in 128 | let split_version v = 129 | let (p1,rest) = match (string_split ':' v ~limit:2) with 130 | [ _ ] -> ("", v) 131 | | [ p1; rest] -> (p1, rest) in 132 | let (p1, p2, p3) = match (string_split '-' rest ~limit:2) with 133 | [ _ ] -> (p1, rest, "") 134 | | [ p2 ; p3 ] -> (p1, p2, p3) in 135 | (p1, p2, p3) 136 | in 137 | let compare_part p1 p2 = 138 | let l1 = String.length p1 in 139 | let l2 = String.length p2 in 140 | let is_digit = function | '0'..'9' -> true | _ -> false in 141 | let rec loop i1 i2 = 142 | let compare_numbers i1 i2 = 143 | let rec loop_numbers n1 n2 last = 144 | if n2 = last then loop n1 n2 145 | else 146 | let comp = Char.compare p1.[n1] p2.[n2] in 147 | if comp = 0 then loop_numbers (n1 + 1) (n2 + 1) last else comp 148 | in 149 | let end1 = skip i1 is_digit p1 l1 in 150 | let end2 = skip i2 is_digit p2 l2 in 151 | let comp = compare (end1 - i1) (end2 - i2) in 152 | if comp = 0 then loop_numbers i1 i2 end1 else comp 153 | in 154 | match (i1 = l1, i2 = l2) with 155 | | true,true -> 0 156 | | true,false -> let end2 = skip i2 (fun c -> c = '0') p2 l2 in 157 | if end2 = l2 then 0 else -1 158 | | false,true -> let end1 = skip i1 (fun c -> c = '0') p1 l1 in 159 | if end1 = l1 then 0 else 1 160 | | false,false -> match (is_digit p1.[i1], is_digit p2.[i2]) with 161 | | true,true -> 162 | compare_numbers (skip i1 (fun c -> c = '0') p1 l1) (skip i2 (fun c -> c = '0') p2 l2) 163 | | true,false -> -1 164 | | false,true -> 1 165 | | false,false -> let comp = Char.compare p1.[i1] p2.[i2] in 166 | if comp = 0 then loop (i1 + 1) (i2 + 1) else comp 167 | in 168 | loop 0 0 169 | in 170 | if v1 = v2 then 0 171 | else 172 | let (v1_1, v1_2, v1_3) = split_version v1 in 173 | let (v2_1, v2_2, v2_3) = split_version v2 in 174 | let c1 = compare_part v1_1 v2_1 in 175 | if c1 <> 0 then c1 else 176 | let c2 = compare_part v1_2 v2_2 in 177 | if c2 <> 0 then c2 else 178 | compare_part v1_3 v2_3 179 | 180 | let rec eval version constr = 181 | match constr with 182 | | And (e1,e2) -> (eval version e1) && (eval version e2) 183 | | Or (e1,e2) -> (eval version e1) || (eval version e2) 184 | | Not e -> not (eval version e) 185 | | Paren e -> eval version e 186 | | Eq v -> compare_version version v = 0 187 | | Le v -> compare_version version v <= 0 188 | | Lt v -> compare_version version v < 0 189 | | Ge v -> compare_version version v >= 0 190 | | Gt v -> compare_version version v > 0 191 | | Ne v -> compare_version version v <> 0 192 | 193 | let rec to_string = function 194 | | And (e1,e2) -> (to_string e1) ^ " && " ^ (to_string e2) 195 | | Or (e1,e2) -> (to_string e1) ^ " || " ^ (to_string e2) 196 | | Not e -> "! " ^ (to_string e) 197 | | Paren e -> "(" ^ (to_string e) ^ ")" 198 | | Eq v -> "=" ^ v 199 | | Le v -> "<=" ^ v 200 | | Lt v -> "<" ^ v 201 | | Ge v -> ">=" ^ v 202 | | Gt v -> ">" ^ v 203 | | Ne v -> "!=" ^ v 204 | 205 | let showList sep f l = String.concat sep (List.map f l) 206 | 207 | let parse_expr l = 208 | let rec parse_sub_expr l = 209 | match l with 210 | | [] -> raise MalformedExpression 211 | | Token.NOT :: r -> 212 | let (e, r) = parse_sub_expr r in ((Not e), r) 213 | | Token.LPAREN :: r -> 214 | let (e, r) = parse_sub_expr r in 215 | let rec loop e r = 216 | (match r with 217 | | Token.RPAREN :: r -> (Paren e, r) 218 | | Token.OR :: _ | Token.AND :: _ -> 219 | let (e, r) = parse_bin_expr e r in 220 | loop e r 221 | | _ -> raise UnbalancedParenthesis; 222 | ) 223 | in 224 | loop e r 225 | | Token.GT :: Token.VER v :: r -> (Gt v, r) 226 | | Token.GE :: Token.VER v :: r -> (Ge v, r) 227 | | Token.EQ :: Token.VER v :: r -> (Eq v, r) 228 | | Token.LT :: Token.VER v :: r -> (Lt v, r) 229 | | Token.LE :: Token.VER v :: r -> (Le v, r) 230 | | Token.NE :: Token.VER v :: r -> (Ne v, r) 231 | | z -> raise (UnknownExpression (showList "," Token.to_string z)) 232 | and parse_bin_expr expr l = 233 | match l with 234 | | Token.OR :: r -> let (e, r) = parse_sub_expr r in ((Or (expr,e)), r) 235 | | Token.AND :: r -> let (e, r) = parse_sub_expr r in ((And (expr,e)), r) 236 | | _ -> raise MalformedExpression 237 | in 238 | let (e, r) = parse_sub_expr l in 239 | let rec loop e r = 240 | if(List.length r) = 0 then e 241 | else let (e,r) = parse_bin_expr e r in 242 | loop e r 243 | in 244 | loop e r 245 | 246 | let parse_constraints name cs = 247 | try 248 | match cs with 249 | | [] -> None 250 | | expr -> let e = parse_expr expr in 251 | Some e 252 | with e -> 253 | let err = 254 | match e with 255 | | UnknownExpression z -> "unknown constraints expression \"" ^ z ^ "\"" 256 | | UnbalancedParenthesis -> "unbalanced parenthesis" 257 | | MalformedExpression -> "malformed expression" 258 | | _ -> Printexc.to_string e 259 | in 260 | raise (CannotParseConstraints (name,err)) 261 | 262 | let parse name s = 263 | match Token.lexer s with 264 | | [] -> raise ExpressionEmpty 265 | | constraints -> parse_constraints name constraints 266 | 267 | let parse_builddep s = 268 | match Token.lexer s with 269 | | [] -> raise ExpressionEmpty 270 | | Token.ID name :: constraints -> (name, (parse_constraints name constraints)) 271 | | x :: _ -> raise (InvalidDependencyName (Token.to_string x)) 272 | -------------------------------------------------------------------------------- /obuild/filetype.ml: -------------------------------------------------------------------------------- 1 | open Ext.Filepath 2 | 3 | type t = FileML 4 | | FileMLI 5 | | FileH 6 | | FileC 7 | | FileCMX 8 | | FileCMO 9 | | FileCMI 10 | | FileCMA 11 | | FileCMXA 12 | | FileCMXS 13 | | FileCMT 14 | | FileCMTI 15 | | FileO 16 | | FileA 17 | | FileSO 18 | | FileEXE 19 | | FileOther of string 20 | 21 | let of_string s = match s with 22 | | "ml" -> FileML 23 | | "mli" -> FileMLI 24 | | "h" -> FileH 25 | | "c" -> FileC 26 | | "cmx" -> FileCMX 27 | | "cmo" -> FileCMO 28 | | "cmi" -> FileCMI 29 | | "cma" -> FileCMA 30 | | "cmxa" -> FileCMXA 31 | | "cmxs" -> FileCMXS 32 | | "cmt" -> FileCMT 33 | | "cmti" -> FileCMTI 34 | | "o" -> FileO 35 | | "a" -> FileA 36 | | "so" -> FileSO 37 | | "exe" -> FileEXE 38 | | _ -> FileOther s 39 | 40 | let to_string fty = match fty with 41 | | FileML -> "ml" 42 | | FileMLI -> "mli" 43 | | FileH -> "h" 44 | | FileC -> "c" 45 | | FileCMX -> "cmx" 46 | | FileCMO -> "cmo" 47 | | FileCMI -> "cmi" 48 | | FileCMA -> "cma" 49 | | FileCMXA -> "cmxa" 50 | | FileCMXS -> "cmxs" 51 | | FileCMT -> "cmt" 52 | | FileCMTI -> "cmti" 53 | | FileO -> "o" 54 | | FileA -> "a" 55 | | FileSO -> "so" 56 | | FileEXE -> "exe" 57 | | FileOther s -> s 58 | 59 | type id = { 60 | fdep_ty : t; 61 | fdep_path : filepath 62 | } 63 | 64 | let make_id (ty,p) = { fdep_ty = ty; fdep_path = p } 65 | let get_id fdep = (fdep.fdep_ty, fdep.fdep_path) 66 | let get_type fdep = fdep.fdep_ty 67 | let get_path fdep = fdep.fdep_path 68 | 69 | let of_filename (name : filename) : t = 70 | try 71 | let nameUnpack = fn_to_string name in 72 | let len = String.length (Filename.chop_extension nameUnpack) in 73 | (* +1 to remove the dot *) 74 | of_string (String.sub nameUnpack (len+1) (String.length nameUnpack - len - 1)) 75 | with Invalid_argument _ -> FileEXE (* best effort, suit our case for unix *) 76 | 77 | let of_filepath (path : filepath) : t = of_filename (path_basename path) 78 | 79 | let replace_extension (name:filename) ext = 80 | let extStr = to_string ext in 81 | try 82 | let choppedName = Filename.chop_extension (fn_to_string name) in 83 | fn (String.concat "." [ choppedName; extStr ]) 84 | with Invalid_argument _ -> 85 | fn (fn_to_string name ^ "." ^ extStr) 86 | 87 | let replace_extension_path path ext = 88 | let dir = path_dirname path in 89 | dir replace_extension (path_basename path) ext 90 | -------------------------------------------------------------------------------- /obuild/findlibConf.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext 4 | 5 | type t = { 6 | path : filepath list; 7 | destdir : filepath option; 8 | all : (string * string option) list; 9 | loaded : bool 10 | } 11 | 12 | let default = { 13 | all = []; 14 | path = []; 15 | destdir = None; 16 | loaded = false 17 | } 18 | 19 | let conf = ref default 20 | 21 | let parse_file path = 22 | let content = Filesystem.readFile path in 23 | let unquote s = match s with 24 | | None -> failwith ("unknown configuration key with no value") 25 | | Some x -> string_init 1 (string_drop 1 x) 26 | in 27 | let kvs = List.map Utils.toKVeq (string_lines_noempty content) in 28 | let paths = string_split ':' (unquote (List.assoc "path" kvs)) in 29 | let destdir = unquote (List.assoc "destdir" kvs) in 30 | { 31 | all = kvs; 32 | path = List.map fp paths; 33 | destdir = Some (fp destdir); 34 | loaded = true; 35 | } 36 | 37 | let get_program_config () = match Process.run [ "ocamlfind"; "printconf"; "conf" ] with 38 | | Process.Failure err -> failwith ("ocamlfind printconf failed err " ^ err) 39 | | Process.Success (out,_,_) -> match string_lines_noempty out with 40 | | [x] -> [fp x] 41 | | _ -> failwith ("ocamlfind printconf failed output: " ^ out) 42 | 43 | let get_paths () = try [fp (Sys.getenv "OCAMLFIND_CONF")] 44 | with Not_found -> 45 | try get_program_config () 46 | with _ -> [ 47 | fp "/etc/findlib.conf"; 48 | fp "/etc/ocamlfind.conf" 49 | ] 50 | 51 | let get_system () = let paths = get_paths () in 52 | try 53 | let found_path = List.find Filesystem.exists paths in 54 | parse_file found_path 55 | with Not_found -> default 56 | 57 | let load () = match Gconf.get_env ("findlib-path") with 58 | | None -> conf := get_system () 59 | | Some p -> conf := parse_file (fp p) 60 | 61 | let get_paths () = (!conf).path 62 | let get_destdir () = (!conf).destdir 63 | -------------------------------------------------------------------------------- /obuild/gconf.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | 3 | type verbosity_t = Silent | Report | Verbose | Debug | DebugPlus 4 | 5 | type t = { 6 | mutable verbosity : verbosity_t; 7 | mutable strict : bool; 8 | mutable parallel_jobs : int; 9 | mutable dump_dot : bool; 10 | mutable color : bool; 11 | mutable bin_annot : bool; 12 | mutable short_path : bool; 13 | mutable ocamlmklib : bool; 14 | mutable ocaml_extra_args : string list; 15 | } 16 | 17 | exception UnknownOption of string 18 | 19 | let env_variables = [ 20 | "ocamlopt"; "ocamlc"; "ocaml"; "ocamldep"; "ocamldoc"; "ocamlyacc"; "ocamllex"; "ocamlmklib"; 21 | "ocamlmktop"; "cc"; "ranlib"; "ar"; "ld"; "pkg-config"; "camlp4"; "findlib-path"; "atdgen" 22 | ] 23 | 24 | let env_ = 25 | let h : (string,string option) Hashtbl.t = Hashtbl.create (List.length env_variables) in 26 | List.iter (fun v -> Hashtbl.add h v None) env_variables; 27 | h 28 | 29 | let get_env field = try 30 | Hashtbl.find env_ field 31 | with Not_found -> raise (UnknownOption field) 32 | 33 | let set_env field value = 34 | if not (Hashtbl.mem env_ field) then raise (UnknownOption field); 35 | Hashtbl.replace env_ field (Some value) 36 | 37 | let target_options_defaults = [ 38 | ("executable-profiling", false); 39 | ("executable-debugging", false); 40 | ("executable-native", true); 41 | ("executable-bytecode", false); 42 | ("executable-as-obj", false); 43 | ("library-profiling", false); 44 | ("library-debugging", false); 45 | ("library-native", true); 46 | ("library-bytecode", true); 47 | ("library-plugin", (if Sys.os_type = "Unix" then true else false)); 48 | ("build-benchs", false); 49 | ("build-tests", false); 50 | ("build-examples", false); 51 | ("annot", false); 52 | ] 53 | 54 | let target_options_ = 55 | let h = Hashtbl.create (List.length target_options_defaults) in 56 | List.iter (fun (k,v) -> Hashtbl.add h k v) target_options_defaults; 57 | h 58 | 59 | let rec set_target_options field value = 60 | if not (Hashtbl.mem target_options_ field) then raise (UnknownOption field); 61 | Hashtbl.replace target_options_ field value; 62 | (match field,value with 63 | | "executable-profiling", true -> set_target_options "library-profiling" true 64 | | "executable-debugging", true -> set_target_options "library-debugging" true 65 | | "library-plugin", true -> set_target_options "library-native" true 66 | | _ -> ()) 67 | 68 | let get_target_options_keys () = hashtbl_keys target_options_ 69 | let get_target_options () = hashtbl_toList target_options_ 70 | let get_target_option field = try 71 | Hashtbl.find target_options_ field 72 | with Not_found -> raise (UnknownOption field) 73 | 74 | let defaults = { 75 | verbosity = Report; 76 | strict = false; 77 | parallel_jobs = 2; 78 | dump_dot = false; 79 | color = false; 80 | bin_annot = true; 81 | short_path = false; 82 | ocamlmklib = true; 83 | ocaml_extra_args = []; 84 | } 85 | 86 | let gconf = defaults 87 | -------------------------------------------------------------------------------- /obuild/generators.ml: -------------------------------------------------------------------------------- 1 | open Ext.Filepath 2 | open Helper 3 | open Gconf 4 | 5 | exception GeneratorFailed of string 6 | exception GeneratorNotFound of string 7 | 8 | type t = { 9 | suffix : string; 10 | modname : (Modname.t -> Modname.t); 11 | commands : (filepath -> filepath -> string -> string list list); 12 | generated_files : (filename -> string -> filename); 13 | } 14 | 15 | let generators = ref [ 16 | { suffix = "mll"; 17 | modname = (fun m -> m); 18 | commands = (fun src dest_root _ -> [[Prog.getOcamlLex (); "-o"; (fp_to_string dest_root) ^ ".ml"; fp_to_string src]]); 19 | generated_files = (fun f _ -> (chop_extension f) <.> "ml") 20 | }; 21 | { suffix = "mly"; 22 | modname = (fun m -> m); 23 | commands = (fun src dest_root _ -> [[Prog.getOcamlYacc (); "-b"; fp_to_string dest_root; fp_to_string src]]); 24 | generated_files = (fun f _ -> (chop_extension f) <.> "ml") 25 | }; 26 | { suffix = "atd"; 27 | modname = (fun m -> Modname.atd_modname m); 28 | commands = (fun src dest_root moduleName -> 29 | let len = String.length moduleName in 30 | let ext = String.sub moduleName (len - 2) 2 in 31 | match ext with 32 | | "_t" -> 33 | [[Prog.getAtdGen (); "-t"; fp_to_string src; "-o"; (fp_to_string dest_root)]] 34 | | "_v" -> 35 | [[Prog.getAtdGen (); "-v"; fp_to_string src; "-o"; (fp_to_string dest_root)]] 36 | | "_j" -> 37 | [[Prog.getAtdGen (); "-j"; "-j-std"; fp_to_string src; "-o"; (fp_to_string dest_root)]] 38 | | _ -> raise (GeneratorFailed ("extension " ^ ext ^ " is unknown")) 39 | ); 40 | generated_files = (fun f moduleName -> let base = fn_to_string (chop_extension f) in 41 | let len = String.length moduleName in 42 | let ext = String.sub moduleName (len - 2) 2 in 43 | match ext with 44 | | "_t" -> fn (base ^ "_t.ml") 45 | | "_v" -> fn (base ^ "_v.ml") 46 | | "_j" -> fn (base ^ "_j.ml") 47 | | _ -> raise (GeneratorFailed ("extension " ^ ext ^ " is unknown")) 48 | ) 49 | }; 50 | ] 51 | 52 | let is_generator_ext ext = List.exists (fun gen -> gen.suffix = ext) !generators 53 | let get_generator fp = 54 | let ext = Filetype.of_filepath fp in 55 | let s = match ext with Filetype.FileOther s -> s | _ -> raise (GeneratorNotFound (fp_to_string fp)) in 56 | List.find (fun gen -> gen.suffix = s) !generators 57 | 58 | let run dest src modName = 59 | verbose Debug " generator dest = %s src = %s\n%!" (fp_to_string dest) (fp_to_string src); 60 | let gen = get_generator src in 61 | let args = gen.commands src dest modName in 62 | List.iter (fun arg -> 63 | match Process.run arg with 64 | | Process.Success (_, warnings,_) -> print_warnings warnings 65 | | Process.Failure er -> raise (GeneratorFailed er) ) args 66 | -------------------------------------------------------------------------------- /obuild/helper.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Gconf 3 | 4 | let print_warnings warnings = 5 | if warnings <> "" then fprintf stderr "%s\n%!" warnings else () 6 | 7 | let log lvl fmt = 8 | if lvl <= gconf.verbosity 9 | then printf fmt 10 | else ifprintf stdout fmt 11 | 12 | let debug fmt = log Gconf.Debug fmt 13 | let report fmt = log Gconf.Report fmt 14 | 15 | (* deprecated, replace by other stuff *) 16 | let verbose lvl fmt = 17 | if lvl <= gconf.verbosity 18 | then printf fmt 19 | else ifprintf stdout fmt 20 | 21 | let support_color () = 22 | if Utils.isWindows 23 | then false 24 | else if Unix.isatty Unix.stdout 25 | then Gconf.gconf.color 26 | else false 27 | 28 | let color_red () = if support_color () then "\x1b[1;31m" else "" 29 | let color_green () = if support_color () then "\x1b[1;32m" else "" 30 | let color_blue () = if support_color () then "\x1b[1;34m" else "" 31 | let color_white () = if support_color () then "\x1b[0m" else "" 32 | -------------------------------------------------------------------------------- /obuild/hier.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext.Compat 4 | open Types 5 | 6 | exception EmptyModuleHierarchy 7 | 8 | type t = Modname.t list 9 | 10 | (* first filepath is the source path, second is the actual path *) 11 | type file_entry = 12 | | FileEntry of (filepath * filepath) (* root_path, full_path *) 13 | | GeneratedFileEntry of (filepath * filepath * filename) 14 | (* root_path, full_path, generated_path *) 15 | | DirectoryEntry of (filepath * filepath) 16 | (* root_path, full_path *) 17 | 18 | let file_entry_to_string = function 19 | | FileEntry (p, f) -> Printf.sprintf "FileEntry %s %s" (fp_to_string p) (fp_to_string f) 20 | | DirectoryEntry (p, f) -> Printf.sprintf "DirectoryEntry %s %s" (fp_to_string p) (fp_to_string f) 21 | | GeneratedFileEntry (p, f, n) -> 22 | Printf.sprintf "GeneratedFileEntry %s %s %s" (fp_to_string p) (fp_to_string f) 23 | (fn_to_string n) 24 | 25 | let hiers : (t, file_entry) Hashtbl.t = Hashtbl.create 128 26 | let root = List.hd 27 | 28 | let parent x = 29 | match x with 30 | | [] -> assert false 31 | | [ _ ] -> None 32 | | l -> Some (list_init l) 33 | 34 | let leaf = list_last 35 | let make l = if l = [] then raise EmptyModuleHierarchy else l 36 | let lvl x = List.length x - 1 37 | let to_string x = String.concat "." (List.map Modname.to_string x) 38 | 39 | let of_string x = 40 | let l = string_split '.' x in 41 | make (List.map Modname.of_string l) 42 | 43 | let ml_to_ext path ext = 44 | let f = path_basename path in 45 | let d = path_dirname path in 46 | d (chop_extension f <.> Filetype.to_string ext) 47 | 48 | let of_modname x = [ x ] 49 | let to_node x = x 50 | 51 | let to_dirpath x = 52 | if List.length x > 1 then 53 | fp (String.concat Filename.dir_sep (List.map Modname.to_dir $ list_init x)) 54 | else 55 | currentDir 56 | 57 | let append x m = x @ [ m ] 58 | 59 | let add_prefix prefix_path hier = 60 | if List.length hier <= 1 then 61 | prefix_path 62 | else 63 | let to_fp = fp (String.concat Filename.dir_sep (List.map Modname.to_dir $ list_init hier)) in 64 | if path_length prefix_path = 0 then 65 | to_fp 66 | else 67 | let rec loop path hier_list = 68 | match hier_list with 69 | | [] -> path to_fp 70 | | x :: xs -> 71 | if path_basename path = fn (Modname.to_dir x) then 72 | if path_length prefix_path = 1 then 73 | to_fp (* prefix_path is fully included in hier *) 74 | else 75 | loop (path_dirname path) xs 76 | else 77 | path to_fp 78 | in 79 | loop prefix_path (List.tl (List.rev hier)) 80 | 81 | let check_file path filename ext = 82 | if ext <> Filetype.FileOther "" then 83 | Ext.Filesystem.exists (path (fn filename <.> Filetype.to_string ext)) 84 | else 85 | Ext.Filesystem.exists (path fn filename) 86 | 87 | let check_modname path modname ext = 88 | if check_file path modname ext then 89 | Some modname 90 | else 91 | let name = string_uncapitalize modname in 92 | if check_file path name ext then 93 | Some name 94 | else 95 | None 96 | 97 | let get_filepath root_path hier ext : file_entry option = 98 | if Hashtbl.mem hiers hier then 99 | Some (Hashtbl.find hiers hier) 100 | else 101 | let path = add_prefix root_path hier in 102 | let modname = Modname.to_string (leaf hier) in 103 | let res = check_modname path modname ext in 104 | match res with 105 | | None -> None 106 | | Some name -> 107 | let entry = 108 | if ext <> Filetype.FileOther "" then 109 | FileEntry (root_path, path (fn name <.> Filetype.to_string ext)) 110 | else 111 | DirectoryEntry (root_path, path fn name) 112 | in 113 | Hashtbl.add hiers hier entry; 114 | Some entry 115 | 116 | let to_filename hier prefix_path = get_filepath prefix_path hier Filetype.FileML 117 | let to_directory hier prefix_path = get_filepath prefix_path hier (Filetype.FileOther "") 118 | 119 | let to_generators hier prefix_path = 120 | if Hashtbl.mem hiers hier then 121 | Some (Hashtbl.find hiers hier) 122 | else 123 | try 124 | Some 125 | (list_findmap 126 | (fun gen -> 127 | let path = add_prefix prefix_path hier in 128 | let modname = Modname.to_string (leaf hier) in 129 | let modname = gen.Generators.modname modname in 130 | let ext = Filetype.FileOther gen.Generators.suffix in 131 | let res = check_modname path modname ext in 132 | match res with 133 | | None -> None 134 | | Some name -> 135 | let filename = fn name <.> Filetype.to_string ext in 136 | let fullname = path filename in 137 | let generated_file = 138 | gen.Generators.generated_files filename (Modname.to_string (leaf hier)) 139 | in 140 | Hashtbl.add hiers hier (GeneratedFileEntry (prefix_path, fullname, generated_file)); 141 | Some (GeneratedFileEntry (prefix_path, fullname, generated_file))) 142 | !Generators.generators) 143 | with Not_found -> None 144 | 145 | let get_src_file dst_dir = function 146 | | FileEntry (_, f) -> f 147 | | GeneratedFileEntry (_, _, fn) -> dst_dir fn 148 | | DirectoryEntry (_, f) -> f 149 | 150 | let get_dest_file dst_dir ext hier = 151 | let entry = Hashtbl.find hiers hier in 152 | match entry with 153 | | FileEntry (_, f) -> 154 | let filename = path_basename f in 155 | let path = add_prefix dst_dir hier in 156 | path (chop_extension filename <.> Filetype.to_string ext) 157 | | GeneratedFileEntry (_, _, filename) -> 158 | let path = add_prefix dst_dir hier in 159 | path (chop_extension filename <.> Filetype.to_string ext) 160 | | DirectoryEntry (_, f) -> 161 | let filename = path_basename f in 162 | let path = add_prefix dst_dir hier in 163 | path (filename <.> Filetype.to_string ext) 164 | 165 | let get_dest_file_ext dst_dir hier ext_f = 166 | let entry = Hashtbl.find hiers hier in 167 | match entry with 168 | | FileEntry (_, f) -> 169 | let filename = path_basename f in 170 | let filetype = Filetype.of_filepath f in 171 | let path = add_prefix dst_dir hier in 172 | path (chop_extension filename <.> Filetype.to_string (ext_f filetype)) 173 | | GeneratedFileEntry (_, _, filename) -> 174 | let path = add_prefix dst_dir hier in 175 | let filetype = Filetype.of_filename filename in 176 | path (chop_extension filename <.> Filetype.to_string (ext_f filetype)) 177 | | DirectoryEntry (_, f) -> 178 | let filename = path_basename f in 179 | let path = add_prefix dst_dir hier in 180 | let filetype = Filetype.of_filepath f in 181 | path (filename <.> Filetype.to_string (ext_f filetype)) 182 | 183 | let to_interface hier prefix_path = get_filepath prefix_path hier Filetype.FileMLI 184 | 185 | let get_file_entry_maybe hier = 186 | if Hashtbl.mem hiers hier then 187 | Some (Hashtbl.find hiers hier) 188 | else 189 | None 190 | 191 | let get_file_entry hier paths = 192 | if Hashtbl.mem hiers hier then 193 | Hashtbl.find hiers hier 194 | else 195 | list_findmap 196 | (fun path -> 197 | try 198 | Some 199 | (list_findmap 200 | (fun lookup -> lookup hier path) 201 | [ to_filename; to_directory; to_generators; to_interface ]) 202 | with Not_found -> None) 203 | paths 204 | 205 | let of_filename filename = 206 | let name = Filename.chop_extension (fn_to_string filename) in 207 | let m = 208 | try Modname.wrap (string_capitalize name) with 209 | | Modname.EmptyModuleName -> raise (Modname.ModuleFilenameNotValid (fn_to_string filename)) 210 | | Invalid_argument _ -> raise (Modname.ModuleFilenameNotValid (fn_to_string filename)) 211 | in 212 | make [ m ] 213 | -------------------------------------------------------------------------------- /obuild/libname.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Types 3 | open Ext.Filepath 4 | 5 | exception EmptyLibName 6 | 7 | (* represent a library in a form abc[.def.xyz] *) 8 | type t = { 9 | main_name : string; 10 | subnames : string list 11 | } 12 | 13 | let of_string s = 14 | match string_split '.' s with 15 | | [] -> raise EmptyLibName 16 | | x::xs -> { main_name = x; subnames = xs } 17 | 18 | let to_string lname = String.concat "." (lname.main_name :: lname.subnames) 19 | let to_string_nodes lname = lname.main_name :: lname.subnames 20 | 21 | let append lname sub = { lname with subnames = lname.subnames @ [sub] } 22 | 23 | let to_libstring lib = String.concat "_" (to_string_nodes lib) 24 | let to_cmxs (compileType: ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cmxs") 25 | let to_cmxa (compileType: ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cmxa") 26 | let to_cma (compileType: ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cma") 27 | let to_cmca b = if b = Native then to_cmxa else to_cma 28 | 29 | (* only used for stdlib stuff *) 30 | (* 31 | let of_cmca b file = 32 | let suffix = if b = Native then ".cmxa" else ".cma" in 33 | Filename.chop_suffix (fn_to_string file) suffix 34 | *) 35 | 36 | -------------------------------------------------------------------------------- /obuild/metacache.ml: -------------------------------------------------------------------------------- 1 | open Meta 2 | open Gconf 3 | open Helper 4 | 5 | let pkgs_cache : (string, Meta.t) Hashtbl.t = Hashtbl.create 100 6 | 7 | let get_from_disk name = 8 | verbose Debug " fetching META %s\n%!" name; 9 | try 10 | Meta.findLib name 11 | with Meta.LibraryNotFound n -> 12 | raise (Dependencies.DependencyMissing n) 13 | 14 | let get name = 15 | try 16 | Hashtbl.find pkgs_cache name 17 | with Not_found -> 18 | let r = get_from_disk name in 19 | Hashtbl.add pkgs_cache name r; 20 | r 21 | 22 | let get_from_cache lib = 23 | try 24 | let (fp,pkg) = Hashtbl.find pkgs_cache lib.Libname.main_name in 25 | if (List.length lib.Libname.subnames) > 0 then 26 | (fp, Meta.Pkg.find lib.Libname.subnames pkg) 27 | else 28 | (fp,pkg) 29 | with Not_found -> 30 | failwith (Printf.sprintf "package %s not found in the hashtbl: internal error" (Libname.to_string lib)) 31 | 32 | let add name meta = 33 | Hashtbl.add pkgs_cache name meta 34 | 35 | let find name = 36 | try 37 | Some (Hashtbl.find pkgs_cache name) 38 | with Not_found -> None 39 | -------------------------------------------------------------------------------- /obuild/modname.ml: -------------------------------------------------------------------------------- 1 | open Ext.Filepath 2 | open Ext.Fugue 3 | open Ext.Compat 4 | 5 | type t = string 6 | 7 | exception InvalidModuleName of string 8 | exception EmptyModuleName 9 | exception ModuleFilenameNotValid of string 10 | 11 | let char_isalpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') 12 | let char_is_valid_modchar c = char_isalpha c || (c >= '0' && c <= '9') || c == '_' 13 | 14 | let string_all p s = 15 | let valid = ref true in 16 | for i = 0 to String.length s - 1 do 17 | valid := !valid && p s.[i] 18 | done; 19 | !valid 20 | 21 | let wrap x = 22 | if String.length x = 0 then 23 | raise EmptyModuleName 24 | else if not (string_all char_is_valid_modchar x) then 25 | raise (InvalidModuleName x) 26 | else if char_uppercase x.[0] <> x.[0] then 27 | raise (InvalidModuleName x) 28 | else 29 | x 30 | 31 | let of_string x = wrap x 32 | let to_string x = x 33 | let to_dir x = string_uncapitalize x 34 | let to_x ext modname = fn (string_uncapitalize modname ^ ext) 35 | let to_o = to_x ".o" 36 | let to_directory = to_x "" 37 | let to_filename = to_x ".ml" 38 | let to_parser = to_x ".mly" 39 | let to_lexer = to_x ".mll" 40 | 41 | let atd_modname modname = 42 | if String.length modname > 2 then 43 | let b, e = string_splitAt (String.length modname - 2) modname in 44 | match e with 45 | | "_t" | "_v" | "_j" -> b 46 | | _ -> modname 47 | else 48 | modname 49 | 50 | let to_atd modname = to_x ".atd" (atd_modname modname) 51 | let module_lookup_methods = [ to_directory; to_parser; to_lexer; to_atd; to_filename ] 52 | let of_directory filename = wrap (string_capitalize (fn_to_string filename)) 53 | 54 | let of_filename filename = 55 | try wrap (string_capitalize (Filename.chop_extension (fn_to_string filename))) with 56 | | EmptyModuleName -> raise (ModuleFilenameNotValid (fn_to_string filename)) 57 | | Invalid_argument _ -> raise (ModuleFilenameNotValid (fn_to_string filename)) 58 | -------------------------------------------------------------------------------- /obuild/pp.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Compat 3 | 4 | exception InvalidPreprocessor of string 5 | 6 | (* 7 | http://ocaml.org/tutorials/camlp4_3.10.html 8 | *) 9 | type package = string list 10 | 11 | module Type = struct 12 | type t = 13 | | CamlP4O 14 | | CamlP4R 15 | 16 | let of_string s = 17 | match Ext.Compat.string_lowercase s with 18 | | "p4o" | "camlp4o" -> CamlP4O 19 | | "p4r" | "camlp4r" -> CamlP4R 20 | | _ -> raise (InvalidPreprocessor s) 21 | 22 | let to_string = function 23 | | CamlP4O -> "camlp4o" 24 | | CamlP4R -> "camlp4r" 25 | end 26 | 27 | type desc = { 28 | camlp4 : string; 29 | packages : package list; 30 | } 31 | 32 | type t = desc option 33 | 34 | let some s pkgs = Some { camlp4 = s; packages = pkgs } 35 | let none = None 36 | 37 | let append pp pkgs = 38 | match pp with 39 | | None -> pp 40 | | Some d -> Some { d with packages = d.packages @ pkgs } 41 | 42 | let to_params pp = 43 | maybe [] 44 | (fun desc -> 45 | let s = 46 | desc.camlp4 ^ " " ^ String.concat " " (List.concat (List.map (fun x -> x) desc.packages)) 47 | in 48 | [ "-pp"; s ]) 49 | pp 50 | -------------------------------------------------------------------------------- /obuild/process.ml: -------------------------------------------------------------------------------- 1 | open Helper 2 | open Gconf 3 | open Ext.Compat 4 | 5 | type output = { 6 | buf : Buffer.t; 7 | fd : Unix.file_descr; 8 | mutable closed : bool; 9 | } 10 | 11 | let create_output fd = { 12 | buf = Buffer.create 1024; 13 | fd = fd; 14 | closed = false; 15 | } 16 | 17 | type t = { 18 | args : string list; (* command args *) 19 | pid : int; (* process PID *) 20 | time : float; (* Process starting time *) 21 | out : output; 22 | err : output; 23 | } 24 | 25 | (* create a new process with stdout and stderr redirected 26 | * and returns a new process_state 27 | *) 28 | let make args = 29 | let escape s = try 30 | let _ = String.index s ' ' in "\"" ^ s ^ "\"" 31 | with Not_found -> s in 32 | verbose DebugPlus " [CMD]: %s\n%!" (String.concat " " (List.map escape args)); 33 | let (r1,w1) = Unix.pipe () in 34 | let (r2,w2) = Unix.pipe () in 35 | let argv = Array.of_list args in 36 | let pid = Unix.create_process argv.(0) argv Unix.stdin w1 w2 in 37 | List.iter Unix.close [w1;w2]; 38 | { 39 | args = args; 40 | out = create_output r1; 41 | err = create_output r2; 42 | pid = pid; 43 | time = Unix.gettimeofday (); 44 | } 45 | 46 | type result = Success of string (* stdout *) * string (* stderr *) * float (* duration *) 47 | | Failure of string (* sterr *) 48 | 49 | type call = unit -> t 50 | 51 | (* process a list of processes until one finish. 52 | * The finishing 'signal' is when both stdout 53 | * and stderr are eofed. *) 54 | let wait processes = 55 | let is_finished (_, p) = p.err.closed && p.out.closed in 56 | let remove_from_list e list = List.filter (fun x -> x <> e) list in 57 | let process_loop () = 58 | let b = bytes_create 1024 in 59 | let live_processes = ref processes in 60 | let done_processes = ref None in 61 | let read_fds () = List.fold_left (fun acc (_, p) -> 62 | let res = if p.out.closed then acc else p.out.fd :: acc in 63 | if p.err.closed then res else p.err.fd :: res) [] !live_processes in 64 | let fds = ref (read_fds ()) in 65 | (* process until at least one process terminate *) 66 | while !done_processes = None do 67 | let (reads, _, _) = Unix.select !fds [] [] 2.0 in 68 | let check_fd out = 69 | if not out.closed && List.mem out.fd reads then 70 | let nb = Unix.read out.fd b 0 1024 in 71 | if nb > 0 72 | then buffer_add_subbytes out.buf b 0 nb 73 | else (Unix.close out.fd; out.closed <- true; fds := read_fds ()) 74 | in 75 | List.iter (fun (task, p) -> 76 | check_fd p.out; 77 | check_fd p.err; 78 | if !done_processes = None && is_finished (task, p) 79 | then done_processes := Some (task, p) 80 | ) !live_processes; 81 | done; 82 | match !done_processes with 83 | | None -> assert false 84 | | Some finished -> (finished, remove_from_list finished !live_processes) 85 | in 86 | try 87 | let finished = List.find is_finished processes in 88 | (finished, remove_from_list finished processes) 89 | with Not_found -> process_loop () 90 | 91 | (* cleanup a process and return a Success|Failure value. 92 | *) 93 | let terminate (_, p) = 94 | let (_, pstat) = Unix.waitpid [] p.pid in 95 | match pstat with 96 | | Unix.WEXITED 0 -> Success (Buffer.contents p.out.buf, Buffer.contents p.err.buf, Unix.gettimeofday () -. p.time) 97 | | _ -> Failure (Buffer.contents p.err.buf) 98 | 99 | (* simple helper for a single process spawn|process|terminate *) 100 | let run args = 101 | let p = make args in 102 | let (p2, _) = wait [((), p)] in 103 | terminate p2 104 | -------------------------------------------------------------------------------- /obuild/prog.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext 4 | 5 | exception OCamlProgramError of string 6 | exception TarError of string 7 | exception PkgConfigError of string 8 | exception PkgConfigErrorNoVersion 9 | exception PkgConfigErrorUnexpectedOutput of string 10 | exception ProgramNotFound of string 11 | 12 | let get_cache prog names = 13 | let res = Gconf.get_env prog in 14 | match res with 15 | | Some p -> p 16 | | None -> 17 | try 18 | let syspath = Utils.get_system_paths () in 19 | let found = list_findmap (fun n -> 20 | let n = if Utils.isWindows then (n ^ ".exe") else n in 21 | if Filename.is_implicit n 22 | then (try 23 | let found_path = Utils.find_in_paths syspath (fn n) in 24 | Some (fp_to_string (found_path fn n)) 25 | with Utils.FileNotFoundInPaths _ -> None) 26 | else (if Filesystem.exists (fp n) then Some n else None) 27 | ) names 28 | in 29 | Gconf.set_env prog found; 30 | found 31 | with Not_found -> 32 | raise (ProgramNotFound prog) 33 | 34 | 35 | let getOcamlOpt () = get_cache "ocamlopt" ["ocamlopt.opt"; "ocamlopt"] 36 | let getOcamlC () = get_cache "ocamlc" ["ocamlc.opt"; "ocamlc"] 37 | let getOcamlDep () = get_cache "ocamldep" ["ocamldep.opt"; "ocamldep"] 38 | let getOcamlDoc () = get_cache "ocamldoc" ["ocamldoc.opt"; "ocamldoc"] 39 | let getOcamlYacc ()= get_cache "ocamlyacc" ["ocamlyacc"] 40 | let getOcamlLex () = get_cache "ocamllex" ["ocamllex.opt"; "ocamllex"] 41 | let getOcamlMklib () = get_cache "ocamlmklib" ["ocamlmklib"] 42 | let getCamlp4 () = get_cache "camlp4" ["camlp4"] 43 | let getCC () = get_cache "cc" ["gcc"] 44 | let getRanlib () = get_cache "ranlib" ["ranlib"] 45 | let getAR () = get_cache "ar" ["ar"] 46 | let getLD () = get_cache "ld" ["ld"] 47 | let getPkgConfig() = get_cache "pkg-config" ["pkg-config"] 48 | let getOcaml () = get_cache "ocaml" ["ocaml"] 49 | let getOcamlMktop () = get_cache "ocamlmktop" ["ocamlmktop"] 50 | let getAtdGen () = get_cache "atdgen" ["atdgen"; "atdgen.run"] 51 | 52 | let get_ocaml_version cfg = 53 | let ver = Hashtbl.find cfg "version" in 54 | match string_split ~limit:3 '.' ver with 55 | | [major;minor;other] -> (major,minor,other) 56 | | _ -> raise (OCamlProgramError ("ocaml return an unknown version " ^ ver)) 57 | 58 | let ocaml_config = ref None 59 | 60 | let getOcamlConfig () = 61 | match !ocaml_config with 62 | | None -> 63 | (match Process.run [ getOcamlC (); "-config" ] with 64 | | Process.Success (s,_,_) -> 65 | let lines = string_lines_noempty s in 66 | let h = Hashtbl.create 32 in 67 | List.iter (fun l -> 68 | let (k,v) = Utils.toKV l in 69 | Hashtbl.add h k (default "" v) 70 | ) lines; 71 | ocaml_config := Some h; 72 | h 73 | | Process.Failure err -> raise (OCamlProgramError ("ocamlc cannot get config " ^ err))) 74 | | Some h -> h 75 | 76 | let getCamlp4Config () = 77 | match Process.run [ getCamlp4 (); "-where" ] with 78 | | Process.Success (s,_,_) -> 79 | let (l:_) = string_lines_noempty s in 80 | l 81 | | Process.Failure err -> raise (OCamlProgramError ("ocamlopt cannot get config " ^ err)) 82 | 83 | let runTar output dir = 84 | match Process.run [ "tar"; "czf"; output; dir ] with 85 | | Process.Success _ -> () 86 | | Process.Failure err -> raise (TarError err) 87 | 88 | let runPkgConfig typ name = 89 | match Process.run [ getPkgConfig (); typ; name ] with 90 | | Process.Success (s,_,_) -> s 91 | | Process.Failure err -> raise (PkgConfigError err) 92 | 93 | let runPkgConfigVersion name = 94 | let output = runPkgConfig "--version" name in 95 | match string_words_noempty output with 96 | | [ver] -> ver 97 | | [] -> raise PkgConfigErrorNoVersion 98 | | _ -> raise (PkgConfigErrorUnexpectedOutput ("version: " ^ output)) 99 | 100 | let runPkgConfigIncludes name = 101 | let output = runPkgConfig "--cflags" name in 102 | (* FIXME check if every items actually got -L as expected *) 103 | List.map (string_drop 2) (string_words_noempty output) 104 | 105 | let runPkgConfigLibs name = 106 | let output = runPkgConfig "--libs" name in 107 | (* FIXME check if every items actually got -l as expected *) 108 | List.map (string_drop 2) (string_words_noempty output) 109 | -------------------------------------------------------------------------------- /obuild/scheduler.ml: -------------------------------------------------------------------------------- 1 | type call = unit -> Process.t 2 | 3 | (* this is used to control the scheduler behavior 4 | * from the idle function *) 5 | type 'a t = Terminate 6 | | WaitingTask 7 | | AddProcess of ('a * Process.t) 8 | | AddTask of ('a * (call list list)) 9 | | Retry 10 | | FinishTask of 'a 11 | 12 | let to_string = function 13 | | Terminate -> "terminate" 14 | | WaitingTask -> "waiting-task" 15 | | AddProcess (_,_) -> "add-process" 16 | | AddTask (_,_) -> "add-task" 17 | | Retry -> "retry" 18 | | FinishTask _ -> "finish-task" 19 | 20 | type 'a task_group = { 21 | mutable completion : int; 22 | mutable next : ('a * call) list list; 23 | } 24 | 25 | type stats = { 26 | mutable max_runqueue : int; 27 | mutable nb_processes : int; 28 | } 29 | 30 | type 'a state = { 31 | mutable runqueue : ('a * Process.t) list; 32 | mutable waitqueue : ('a * call) list; 33 | mutable terminate : bool; 34 | mutable waiting_task : bool; 35 | mutable tasks : ('a * 'a task_group) list; 36 | } 37 | 38 | (* wait until a process finish. *) 39 | 40 | let wait_process state = 41 | let (proc_done, processes) = Process.wait state.runqueue in 42 | let (task_done,_) = proc_done in 43 | let finished_task = 44 | try 45 | let tg = List.assoc task_done state.tasks in 46 | tg.completion <- tg.completion - 1; 47 | if tg.completion = 0 48 | then ( 49 | match tg.next with 50 | | [] -> 51 | state.tasks <- List.filter (fun (t,_) -> t <> task_done) state.tasks; 52 | true 53 | | g :: gs -> 54 | tg.completion <- List.length g; 55 | tg.next <- gs; 56 | state.waitqueue <- g @ state.waitqueue; 57 | false 58 | ) else 59 | false 60 | with Not_found -> 61 | true 62 | in 63 | state.runqueue <- processes; 64 | (proc_done, finished_task) 65 | 66 | let rec idle_loop idle_fun on_task_finish_fun state = 67 | match idle_fun () with 68 | | Retry -> idle_loop idle_fun on_task_finish_fun state 69 | | AddProcess p -> state.runqueue <- p :: state.runqueue 70 | | WaitingTask -> state.waiting_task <- true 71 | | Terminate -> state.terminate <- true 72 | | FinishTask t -> on_task_finish_fun t; (* retry *) idle_loop idle_fun on_task_finish_fun state 73 | | AddTask (t,ps) -> 74 | (match List.map (List.map (fun p -> (t, p))) ps with 75 | | [] -> failwith "internal error: empty task added to the scheduler" 76 | | first::pss -> 77 | let tg = { 78 | completion = List.length first; 79 | next = pss 80 | } in 81 | state.tasks <- (t,tg) :: state.tasks; 82 | state.waitqueue <- first @ state.waitqueue; 83 | ) 84 | 85 | (* when the scheduler has some room, we get the next task from 86 | * taskdep and either start a process or call retry. 87 | * 88 | * Retry is returned when no process need to be spawned for the next task 89 | * since the dependencies have not changed and thus the cache still have 90 | * valid target file. Instead of returning retry, we could just go get 91 | * the next task ourself. 92 | *) 93 | let schedule_idle taskdep dispatch_fun () = 94 | if Taskdep.is_complete taskdep 95 | then Terminate 96 | else match Taskdep.get_next taskdep with 97 | | None -> WaitingTask 98 | | Some task -> dispatch_fun task 99 | 100 | (* this is a simple one thread loop to schedule 101 | * multiple tasks (forked) until they terminate 102 | * 103 | * the idle_fun function is called when there's capacity in the runqueue for 104 | * another task. 105 | * 106 | * the finish function is called when a subtask of the task has finished. 107 | * if all the subtasks in the task are done then the second value is set 108 | * to true. 109 | **) 110 | let schedule j taskdep dispatch_fun finish_fun = 111 | let st = { 112 | runqueue = []; 113 | waitqueue = []; 114 | terminate = false; 115 | waiting_task = false; 116 | tasks = []; 117 | } in 118 | let on_task_finish task = Taskdep.mark_done taskdep task in 119 | let stats = { max_runqueue = 0; nb_processes = 0 } in 120 | let pick_process (task, process) remaining_processes = 121 | stats.nb_processes <- stats.nb_processes + 1; 122 | st.runqueue <- (task,process ()) :: st.runqueue; 123 | st.waitqueue <- remaining_processes 124 | in 125 | let set_max () = 126 | let m = List.length st.runqueue in 127 | if stats.max_runqueue < m then stats.max_runqueue <- m 128 | in 129 | 130 | (* add more bulletproofing to prevent busy looping for no reason 131 | * if user of this api is not behaving properly *) 132 | while not st.terminate || st.runqueue <> [] || st.waitqueue <> [] do 133 | while not st.terminate && not st.waiting_task && List.length st.runqueue < j do 134 | match st.waitqueue with 135 | | [] -> idle_loop (schedule_idle taskdep dispatch_fun) on_task_finish st 136 | | (t,p)::procs -> pick_process (t,p) procs 137 | done; 138 | set_max (); 139 | 140 | if List.length st.runqueue > 0 141 | then 142 | let (proc_done, finished_task) = wait_process st in 143 | st.waiting_task <- false; 144 | finish_fun proc_done finished_task 145 | else 146 | assert (st.terminate) 147 | done; 148 | stats 149 | -------------------------------------------------------------------------------- /obuild/target.ml: -------------------------------------------------------------------------------- 1 | open Ext.Filepath 2 | open Ext.Fugue 3 | open Types 4 | open Dependencies 5 | 6 | module Typ = struct 7 | type t = Lib | Exe | Test | Bench 8 | 9 | let is_lib t = t = Lib 10 | end 11 | 12 | exception TargetNameNoType of string 13 | exception TargetUnknownType of string * string 14 | exception TargetNotRecognized of string 15 | 16 | 17 | module Name = struct 18 | type t = 19 | Lib of Libname.t 20 | | Exe of string 21 | | Test of string 22 | | Bench of string 23 | | Example of string 24 | 25 | let to_string = function 26 | | Exe e -> "exe-" ^ e 27 | | Bench e -> "bench-" ^ e 28 | | Test e -> "test-" ^ e 29 | | Example e -> "example-" ^ e 30 | | Lib l -> "lib-" ^ Libname.to_string l 31 | 32 | let of_string name = match string_split ~limit:2 '-' name with 33 | | ["exe"; n] -> Exe n 34 | | ["lib"; n] -> Lib (Libname.of_string n) 35 | | ["test"; n] -> Test n 36 | | ["bench"; n] -> Bench n 37 | | ["example"; n] -> Example n 38 | | [prefix; n] -> raise (TargetUnknownType (prefix, n)) 39 | | [_] -> raise (TargetNameNoType name) 40 | | _ -> raise (TargetNotRecognized name) 41 | 42 | let to_dirname = function 43 | | Exe e | Bench e | Test e | Example e -> fn e 44 | | Lib l -> fn ("lib-" ^ Libname.to_string l) 45 | 46 | let get_clibname = function 47 | | Exe e -> "stubs_" ^ e 48 | | Bench e -> "stubs_" ^ e 49 | | Test e -> "stubs_" ^ e 50 | | Example e -> "stubs_" ^ e 51 | | Lib l -> "stubs_" ^ list_last (Libname.to_string_nodes l) 52 | 53 | (* get the core name of the final object representing the object 54 | * for an executable/test/bench it will be the name of the executable apart from the extension 55 | * for a test it will be the name of the library created (.cmxa/.cma) apart from the extension 56 | *) 57 | let get_dest_name = function 58 | | Exe e -> e 59 | | Bench e -> "bench-" ^ e 60 | | Test e -> "test-" ^ e 61 | | Example e -> "example-" ^ e 62 | | Lib l -> String.concat "_" (Libname.to_string_nodes l) 63 | 64 | end 65 | 66 | type target_stdlib = Stdlib_None | Stdlib_Standard | Stdlib_Core 67 | 68 | type runtime_bool = BoolConst of bool 69 | | BoolVariable of string 70 | 71 | let runtime_def v = BoolConst v 72 | 73 | type target_cbits = 74 | { target_cdir : filepath 75 | ; target_csources : filename list 76 | ; target_cflags : string list (* CFLAGS *) 77 | ; target_clibs : string list 78 | ; target_clibpaths : filepath list 79 | ; target_cpkgs : cdependency list (* pkg-config name *) 80 | } 81 | 82 | type target_obits = { 83 | target_srcdir : filepath list; 84 | target_builddeps : dependency list; 85 | target_oflags : string list; 86 | target_pp : Pp.Type.t option; 87 | target_extradeps : (Hier.t * Hier.t) list; 88 | target_stdlib : target_stdlib; 89 | } 90 | 91 | type target_extra = { 92 | target_extra_objects : string list; (* targets of those extra settings *) 93 | target_extra_builddeps : dependency list; 94 | target_extra_oflags : string list; 95 | target_extra_cflags : string list; 96 | target_extra_pp : Pp.Type.t option; 97 | } 98 | 99 | type target = 100 | { target_name : Name.t 101 | ; target_type : Typ.t 102 | ; target_cbits : target_cbits 103 | ; target_obits : target_obits 104 | ; target_extras : target_extra list 105 | ; target_buildable : runtime_bool 106 | ; target_installable : runtime_bool 107 | } 108 | 109 | let newTargetCbits = 110 | { target_cdir = currentDir 111 | ; target_csources = [] 112 | ; target_cflags = [] 113 | ; target_clibs = [] 114 | ; target_clibpaths = [] 115 | ; target_cpkgs = [] 116 | } 117 | 118 | let newTargetObits = { 119 | target_oflags = []; 120 | target_builddeps = []; 121 | target_pp = None; 122 | target_srcdir = [currentDir]; 123 | target_extradeps = []; 124 | target_stdlib = Stdlib_Standard; 125 | } 126 | 127 | let newTarget n ty buildable installable = 128 | { target_name = n 129 | ; target_buildable = runtime_def buildable 130 | ; target_installable = runtime_def installable 131 | ; target_type = ty 132 | ; target_extras = [] 133 | ; target_cbits = newTargetCbits 134 | ; target_obits = newTargetObits 135 | } 136 | 137 | let newTargetExtra objs = { 138 | target_extra_objects = objs; 139 | target_extra_builddeps = []; 140 | target_extra_oflags = []; 141 | target_extra_cflags = []; 142 | target_extra_pp = None; 143 | } 144 | 145 | let get_target_name target = Name.to_string target.target_name 146 | let get_target_dest_name target = Name.get_dest_name target.target_name 147 | let get_target_clibname target = Name.get_clibname target.target_name 148 | 149 | let is_lib target = Typ.is_lib (target.target_type) 150 | 151 | let get_ocaml_compiled_types target = 152 | let (nat,byte) = 153 | if is_lib target 154 | then (Gconf.get_target_option "library-native", Gconf.get_target_option "library-bytecode") 155 | else (Gconf.get_target_option "executable-native", Gconf.get_target_option "executable-bytecode") 156 | in 157 | (if nat then [Native] else []) @ (if byte then [ByteCode] else []) 158 | 159 | let get_debug_profile target = 160 | if is_lib target 161 | then (Gconf.get_target_option "library-debugging", Gconf.get_target_option "library-profiling") 162 | else (Gconf.get_target_option "executable-debugging", Gconf.get_target_option "executable-profiling") 163 | 164 | let get_compilation_opts target = 165 | let (debug, prof) = get_debug_profile target in 166 | Normal :: (if debug then [WithDebug] else []) @ (if prof then [WithProf] else []) 167 | 168 | let get_all_builddeps target = 169 | let targetWideDeps = target.target_obits.target_builddeps in 170 | let fileSpecificDeps = List.map (fun extra -> extra.target_extra_builddeps) target.target_extras in 171 | targetWideDeps @ List.concat fileSpecificDeps 172 | 173 | let find_extra_matching target s = 174 | List.filter (fun extra -> List.mem s extra.target_extra_objects) target.target_extras 175 | -------------------------------------------------------------------------------- /obuild/taskdep.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Ext.Fugue 3 | 4 | type direction = FromChildren | FromParent 5 | 6 | (* this is a simple task dependency 'scheduler' *) 7 | (* TODO Set *) 8 | type 'a t = { 9 | dag : 'a Dag.t; 10 | nb_steps : int; 11 | steps_done : ('a, unit) Hashtbl.t; 12 | direction : direction; 13 | mutable current_step : int; 14 | mutable next_tasks : 'a list; 15 | } 16 | 17 | (* init a new taskdep from a dag *) 18 | let init_with dag direction nodes = { 19 | dag = dag; 20 | nb_steps = Dag.length dag; 21 | current_step = 1; 22 | direction = direction; 23 | steps_done = Hashtbl.create 16; 24 | next_tasks = nodes; 25 | } 26 | 27 | let init ?(direction=FromChildren) dag = 28 | init_with dag direction (if direction = FromChildren then Dag.getLeaves dag else Dag.getRoots dag) 29 | 30 | let next_index taskdep = 31 | let c = taskdep.current_step in 32 | taskdep.current_step <- taskdep.current_step + 1; 33 | c 34 | 35 | (* get next task from the task dependency, and removes it from the next list *) 36 | let get_next taskdep = 37 | let nexts = taskdep.next_tasks in 38 | match nexts with 39 | | [] -> None 40 | | task::xs -> 41 | taskdep.next_tasks <- xs; 42 | Some (next_index taskdep, task) 43 | 44 | let mark_done taskdep step = 45 | Hashtbl.add taskdep.steps_done step (); 46 | (* check if any parents is now free to complete *) 47 | let parents = if taskdep.direction = FromChildren 48 | then Dag.getParents taskdep.dag step 49 | else Dag.getChildren taskdep.dag step in 50 | List.iter (fun parent -> 51 | let children = 52 | if taskdep.direction = FromChildren 53 | then Dag.getChildren taskdep.dag parent 54 | else Dag.getParents taskdep.dag parent 55 | in 56 | let allDone = List.for_all (fun child -> Hashtbl.mem taskdep.steps_done child) children in 57 | if allDone && not (List.mem parent taskdep.next_tasks) then 58 | taskdep.next_tasks <- taskdep.next_tasks @ [parent] 59 | ) parents 60 | 61 | let is_complete taskdep = 62 | Hashtbl.length taskdep.steps_done = taskdep.nb_steps 63 | 64 | let linearize dag direction nodes = 65 | let l = ref [] in 66 | let visited = Hashtbl.create 16 in 67 | let rec visit n = 68 | if not (Hashtbl.mem visited n) then ( 69 | Hashtbl.add visited n (); 70 | List.iter visit ((if direction = FromParent then Dag.getChildren else Dag.getParents) dag n); 71 | l := n :: !l; 72 | ) 73 | in 74 | List.iter visit nodes; 75 | !l 76 | 77 | let dump a_to_string taskdep = 78 | printf "tasks steps done: [%s]\n" (String.concat "," (List.map a_to_string (hashtbl_keys taskdep.steps_done))); 79 | printf "tasks next: [%s]\n" (String.concat "," (List.map a_to_string taskdep.next_tasks)) 80 | -------------------------------------------------------------------------------- /obuild/types.ml: -------------------------------------------------------------------------------- 1 | type ocaml_compilation_option = Normal | WithDebug | WithProf 2 | type ocaml_compiled_type = ByteCode | Native 3 | type ocaml_compilation_mode = Interface | Compiled of ocaml_compiled_type 4 | 5 | let extDP = function 6 | | Normal -> "" 7 | | WithDebug -> ".d" 8 | | WithProf -> ".p" 9 | -------------------------------------------------------------------------------- /obuild/utils.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext 4 | open Types 5 | 6 | let read_file_with f filename = 7 | let lines = ref [] in 8 | let chan = open_in filename in 9 | try 10 | while true; do 11 | let z = f (input_line chan) in 12 | match z with 13 | | None -> () 14 | | Some z' -> lines := z' :: !lines 15 | done; [] 16 | with End_of_file -> 17 | close_in chan; 18 | List.rev !lines 19 | 20 | let toKV line = 21 | match string_split ~limit:2 ':' line with 22 | | [k] -> (string_stripSpaces k, None) 23 | | [k;v] -> (string_stripSpaces k, Some (string_stripSpaces v)) 24 | | _ -> assert false 25 | 26 | let toKVeq line = 27 | match string_split ~limit:2 '=' line with 28 | | [k] -> (string_stripSpaces k, None) 29 | | [k;v] -> (string_stripSpaces k, Some (string_stripSpaces v)) 30 | | _ -> assert false 31 | 32 | let parseCSV value = List.filter (fun s -> (String.length s) > 0) (List.map string_stripSpaces (string_split ',' value)) 33 | 34 | let to_include_path_options paths = 35 | let ss = ref StringSet.empty in 36 | List.concat $ list_filter_map (fun p -> let ps = fp_to_string p in 37 | if (ps = "") || (StringSet.mem ps !ss) || not (Filesystem.exists p) then None 38 | else ( 39 | ss := StringSet.add ps !ss; 40 | Some ["-I"; ps] 41 | )) paths 42 | 43 | let showList sep f l = String.concat sep (List.map f l) 44 | 45 | let isWindows = Sys.os_type = "Win32" 46 | 47 | let to_exe_name mode build name = 48 | let ext = extDP mode in 49 | let ext2 = 50 | match build with 51 | | ByteCode -> ".byte" 52 | | Native -> if (Gconf.get_target_option "executable-as-obj") then ".o" else "" 53 | in 54 | fn (name ^ ext ^ ext2 ^ (if isWindows then ".exe" else "")) 55 | 56 | exception FileNotFoundInPaths of (filepath list * filename) 57 | exception FilesNotFoundInPaths of (filepath list * filepath list) 58 | 59 | let get_system_paths () = 60 | let sep = if isWindows then ';' else ':' in 61 | try List.map fp (string_split sep (Sys.getenv "PATH")) 62 | with Not_found -> List.map fp ["/usr/bin"; "/usr/local/bin"] 63 | 64 | let find_in_paths paths name = 65 | try List.find (fun p -> Filesystem.exists (p name)) paths 66 | with Not_found -> raise (FileNotFoundInPaths (paths, name)) 67 | 68 | let find_choice_in_paths paths names = 69 | try List.find (fun p -> 70 | try let _ = List.find (fun n -> Filesystem.exists (n p)) names in true 71 | with Not_found -> false 72 | ) paths 73 | with Not_found -> raise (FilesNotFoundInPaths (paths, (List.map (fun n -> n (List.hd paths)) names))) 74 | 75 | let exist_choice_in_paths paths names = 76 | try let _ = find_choice_in_paths paths names in true 77 | with FilesNotFoundInPaths _ -> false 78 | 79 | let find_in_system_path name = 80 | find_in_paths (get_system_paths ()) name 81 | 82 | let wrap_exn print fname f = 83 | try f () 84 | with exn -> 85 | print "%s: %s\n%!" fname (Printexc.to_string exn); 86 | raise exn 87 | 88 | let generateFile file f = 89 | let buffer = Buffer.create 1024 in 90 | f (Buffer.add_string buffer); 91 | Filesystem.writeFile file (Buffer.contents buffer) 92 | 93 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "obuild" 3 | version: "0.1.11" 4 | homepage: "https://github.com/ocaml-obuild/obuild" 5 | bug-reports: "https://github.com/ocaml-obuild/obuild/issues" 6 | dev-repo: "git+https://github.com/ocaml-obuild/obuild.git" 7 | authors: ["Vincent Hanquez" "Jerome Maloberti"] 8 | synopsis: "simple package build system for OCaml" 9 | description: """ 10 | The goal is to make a very simple build system for users and developers 11 | of OCaml libraries and programs. 12 | 13 | Obuild acts as a building black box: users only declare what they want to 14 | build and with which sources; the build system will consistently 15 | build it. 16 | 17 | The design is based on Haskell's Cabal and borrows most of the layout 18 | and way of working, adapting parts where necessary to fully support OCaml.""" 19 | 20 | maintainer: "jmaloberti@gmail.com" 21 | build: [ 22 | ["./bootstrap"] 23 | ] 24 | depends: ["ocaml"] 25 | url { 26 | src: "https://github.com/ocaml-obuild/obuild/archive/obuild-v0.1.11.tar.gz" 27 | checksum: "md5=0df5359e3103ee2b52aa90eedc9c045e" 28 | } 29 | -------------------------------------------------------------------------------- /src/doc.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Obuild 3 | 4 | exception DocumentationBuildingFailed of string 5 | 6 | let runOcamldoc pp = 7 | let args = [ Prog.getOcamlDoc (); "-html" ] 8 | @ (maybe [] (fun s -> ["-pp"; s ]) pp) 9 | @ [] 10 | in 11 | match Process.run args with 12 | | Process.Failure er -> raise (DocumentationBuildingFailed er) 13 | | Process.Success (_,_,_) -> () 14 | 15 | let run projFile = 16 | () 17 | -------------------------------------------------------------------------------- /src/help.ml: -------------------------------------------------------------------------------- 1 | 2 | let helpConfigure = 3 | [ "Configure --- Prepare to build the package" 4 | ; "" 5 | ; "Configure verify that the environment is able to compile the project" 6 | ; "and this is where the user can tell obuild options to build" 7 | ; "" 8 | ; "System settings and user settings are cached, to provide faster" 9 | ; "access for building task" 10 | ] 11 | 12 | let helpClean = 13 | [ "Clean --- Cleanup after obuild" 14 | ; "" 15 | ; "Remove all by-product of compilation (.cmx, .cmi, .cmo, etc)" 16 | ; "and remove the dist directory." 17 | ] 18 | 19 | let helpBuild = 20 | [ "Build --- Build every buildable bits" 21 | ; "" 22 | ; "Build all your different targets (library, executable," 23 | ; "tests, benchmarks, example) that are marked as buildable." 24 | ] 25 | 26 | let helpSdist = 27 | [ "Sdist --- Create a source distribution file (.tar.gz)" 28 | ; "" 29 | ; "generate a source distribution file .tar.gz that contains" 30 | ; "all the necessary bits to distribute to someone else" 31 | ; "and being able to build and install the package" 32 | ] 33 | 34 | let helpMessages = 35 | [ "clean", helpClean 36 | ; "configure", helpConfigure 37 | ; "build", helpBuild 38 | ; "sdist", helpSdist 39 | ] 40 | -------------------------------------------------------------------------------- /src/init.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Ext.Fugue 3 | open Ext.Filepath 4 | open Ext.Compat 5 | open Ext 6 | open Obuild.Helper 7 | open Obuild.Target 8 | open Obuild.Project 9 | open Obuild 10 | 11 | exception ProjectAlreadyExists 12 | exception CannotRunNotInteractive 13 | exception AbortedByUser 14 | 15 | let rec ask v x = 16 | printf "%s\n> %!" x; 17 | let r = try read_line () with End_of_file -> raise AbortedByUser in 18 | match v r with 19 | | None -> r 20 | | Some vp -> 21 | printf "error: %s\n" vp; 22 | ask v x 23 | 24 | let rec ask_many v x = 25 | let r = ask v x in 26 | if r = "" then [] else r :: ask_many v x 27 | 28 | let run () = 29 | (* check if a project file already exists and that we run in a interactive windows *) 30 | (try 31 | let _ = Project.findPath () in 32 | raise ProjectAlreadyExists 33 | with Project.NoConfFile -> ()); 34 | 35 | if not (Unix.isatty Unix.stdout) then 36 | raise CannotRunNotInteractive; 37 | 38 | printf " %swelcome to the obuild wizard%s\n" (color_green ()) (color_white ()); 39 | printf " ============================\n"; 40 | 41 | let expecting_output l s = 42 | if List.mem s l then 43 | None 44 | else 45 | Some 46 | (sprintf "expecting one of the following: %s" 47 | (Utils.showList ", " (fun s -> "\"" ^ s ^ "\"") l)) 48 | in 49 | 50 | (* strip [ext] from the the end of [s] only if it's there *) 51 | let strip_ext s ~ext = 52 | try 53 | let l = String.length s in 54 | let ext_l = String.length ext in 55 | if String.sub s (l - ext_l) ext_l = ext then 56 | String.sub s 0 (l - ext_l) 57 | else 58 | s 59 | with _ -> s (* in case out of bounds above *) 60 | in 61 | 62 | let invalid ~x = function 63 | | true -> None 64 | | false -> Some ("invalid " ^ x) 65 | in 66 | 67 | let valid_name n = invalid ~x:"name" (string_all char_is_alphanum n) in 68 | let valid_fp _ = None in 69 | (* FIXME *) 70 | let valid_fn n = invalid ~x:"filename" (Filepath.valid_fn n) in 71 | let valid_modname n = 72 | invalid ~x:"module name" (string_all Modname.char_is_valid_modchar (strip_ext n ~ext:".ml")) 73 | in 74 | 75 | let name = ask valid_name "What is the name of your project ?" in 76 | 77 | let obuild = 78 | { 79 | Project.make with 80 | Project.name; 81 | Project.version = "0.0.0"; 82 | Project.synopsis = "my new project"; 83 | Project.obuild_ver = 1; 84 | } 85 | in 86 | 87 | let ty = 88 | ask (expecting_output [ "1"; "2" ]) "What do you want to build ? 1: executable, 2: library" 89 | in 90 | 91 | let question_obits obits = 92 | let dir = ask valid_fp "What is the directory name where to find the source ? (default .)" in 93 | { obits with target_srcdir = [ fp dir ] } 94 | in 95 | let question_cbits cbits = cbits in 96 | 97 | let project = 98 | let compose f g x = f (g x) in 99 | match ty with 100 | | "1" -> 101 | let main = ask valid_fn "What is the name of your main ?" in 102 | let nexe = Executable.make name in 103 | let itarget = nexe.Executable.target in 104 | let target = 105 | { 106 | itarget with 107 | target_obits = question_obits itarget.target_obits; 108 | target_cbits = question_cbits itarget.target_cbits; 109 | } 110 | in 111 | { obuild with exes = [ { nexe with Executable.main = fn main; Executable.target } ] } 112 | | "2" -> 113 | let modules = 114 | List.map 115 | (fun m -> string_capitalize $ strip_ext ~ext:".ml" m) 116 | (ask_many valid_modname "Add a module ? (enter to terminate)") 117 | in 118 | let nlib = Library.make_from_string name in 119 | let itarget = nlib.Library.target in 120 | let target = 121 | { 122 | itarget with 123 | target_obits = question_obits itarget.target_obits; 124 | target_cbits = question_cbits itarget.target_cbits; 125 | } 126 | in 127 | { 128 | obuild with 129 | libs = 130 | [ 131 | { 132 | nlib with 133 | Library.modules = List.map (compose Hier.of_modname Modname.wrap) modules; 134 | Library.target; 135 | }; 136 | ]; 137 | } 138 | | _ -> assert false 139 | in 140 | project 141 | -------------------------------------------------------------------------------- /src/install.ml: -------------------------------------------------------------------------------- 1 | open Obuild 2 | open Ext.Fugue 3 | open Ext.Filepath 4 | open Printf 5 | open Project 6 | open Types 7 | open Target 8 | open Helper 9 | open Gconf 10 | 11 | let list_target_files_pred target pred = 12 | let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in 13 | Build.sanity_check build_dir target; 14 | (* don't play with matches *) 15 | let matches = Ext.Filesystem.list_dir_pred pred build_dir in 16 | (build_dir, matches) 17 | 18 | let list_lib_files lib build_dir = list_target_files_pred lib (fun f -> 19 | if (fn_to_string f) = "META" then true 20 | else 21 | match Filetype.of_filepath (build_dir f) with 22 | | Filetype.FileCMX | Filetype.FileCMI | Filetype.FileA | Filetype.FileCMXS 23 | | Filetype.FileCMXA | Filetype.FileCMA | Filetype.FileCMT | Filetype.FileCMTI -> true 24 | | _ -> false) 25 | 26 | let list_exe_files lib build_dir = list_target_files_pred lib (fun f -> 27 | match Filetype.of_filepath (build_dir f) with 28 | | Filetype.FileEXE -> true 29 | | _ -> false) 30 | 31 | let opam_install_file proj_file flags = 32 | let install_path = fp (proj_file.name ^ ".install") in 33 | Utils.generateFile install_path (fun add -> 34 | let all_targets = Project.get_all_installable_targets proj_file flags in 35 | let print_target_files target list_files_fun = 36 | let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in 37 | let (_, files) = list_files_fun target build_dir in 38 | List.iter (fun file -> let file_str = fn_to_string file in 39 | add (sprintf " \"%s/%s\" {\"%s\"}\n" (fp_to_string build_dir) file_str file_str) 40 | ) files 41 | in 42 | add (sprintf "%s: [\n" "lib"); 43 | List.iter (fun target -> match target.target_name with 44 | | Name.Lib _ -> print_target_files target list_lib_files | _ -> ()) all_targets; 45 | add ("]\n"); 46 | add (sprintf "%s: [\n" "bin"); 47 | List.iter (fun target -> match target.target_name with 48 | | Name.Exe _ -> print_target_files target list_exe_files | _ -> ()) all_targets; 49 | add ("]\n"); 50 | ) 51 | 52 | let lib_to_meta proj_file lib = 53 | let requires_of_lib lib = 54 | let deps = lib.Library.target.target_obits.target_builddeps in 55 | [ ([], List.map (fun d -> fst d) deps) ] 56 | in 57 | let set_meta_field_from_lib pkg lib = { 58 | pkg with Meta.Pkg.requires = requires_of_lib lib; 59 | Meta.Pkg.description = if lib.Library.description <> "" then lib.Library.description else proj_file.description; 60 | Meta.Pkg.archives = [ 61 | ([Meta.Predicate.Byte] , fn_to_string (Libname.to_cmca ByteCode Normal lib.Library.name)); 62 | ([Meta.Predicate.Byte; Meta.Predicate.Plugin] , fn_to_string (Libname.to_cmca ByteCode Normal lib.Library.name)); 63 | ([Meta.Predicate.Native], fn_to_string (Libname.to_cmca Native Normal lib.Library.name)) 64 | ] @ (if (Gconf.get_target_option "library-plugin") then 65 | [([Meta.Predicate.Native; Meta.Predicate.Plugin], fn_to_string (Libname.to_cmxs Normal lib.Library.name))] 66 | else []) 67 | } in 68 | let subPkgs = List.map (fun sub -> 69 | let npkg = Meta.Pkg.make (list_last (Libname.to_string_nodes sub.Library.name)) in 70 | set_meta_field_from_lib npkg sub 71 | ) lib.Library.subs 72 | in 73 | let pkg = set_meta_field_from_lib (Meta.Pkg.make "") lib in { 74 | pkg with Meta.Pkg.version = proj_file.version; 75 | Meta.Pkg.subs = subPkgs 76 | } 77 | 78 | let write_lib_meta projFile lib = 79 | let dir = Dist.get_build_exn (Dist.Target lib.Library.target.target_name) in 80 | let metadir_path = dir fn "META" in 81 | let pkg = lib_to_meta projFile lib in 82 | Meta.Pkg.write metadir_path pkg 83 | 84 | let copy_files files dest_dir dir_name = 85 | List.iter (fun (build_dir, build_files) -> 86 | List.iter (fun build_file -> 87 | Ext.Filesystem.copy_file (build_dir build_file) ((dest_dir dir_name) build_file) 88 | ) build_files; 89 | ) files 90 | 91 | let install_lib proj_file lib dest_dir = 92 | write_lib_meta proj_file lib; 93 | let all_files = List.map (fun target -> 94 | let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in 95 | Build.sanity_check build_dir target; 96 | list_lib_files target build_dir 97 | ) (Project.Library.to_targets lib) in 98 | let dir_name = fn (Libname.to_string lib.Project.Library.name) in 99 | verbose Report "installing library %s\n" (Libname.to_string lib.Project.Library.name); 100 | verbose Debug "installing files: %s\n" (Utils.showList "," 101 | fn_to_string (List.concat (List.map snd all_files))); 102 | copy_files all_files dest_dir dir_name 103 | 104 | let install_libs proj_file destdir opam = 105 | if not opam then 106 | List.iter (fun lib -> install_lib proj_file lib destdir) proj_file.Project.libs 107 | else 108 | List.iter (fun lib -> write_lib_meta proj_file lib) proj_file.Project.libs; 109 | -------------------------------------------------------------------------------- /src/sdist.ml: -------------------------------------------------------------------------------- 1 | open Ext.Fugue 2 | open Ext.Filepath 3 | open Ext 4 | open Obuild.Helper 5 | open Obuild.Target 6 | open Obuild.Gconf 7 | open Obuild 8 | 9 | let run projFile isSnapshot = 10 | let name = projFile.Project.name in 11 | let ver = projFile.Project.version in 12 | let sdistDir = name ^ "-" ^ ver in 13 | let sdistName = fn (sdistDir ^ ".tar.gz") in 14 | 15 | let dest = Dist.get_path () fn sdistDir in 16 | let currentDir = Unix.getcwd () in 17 | let _ = Filesystem.mkdirSafe dest 0o755 in 18 | 19 | (* copy project file and extra source files *) 20 | Filesystem.copy_to_dir (Project.findPath ()) dest; 21 | maybe_unit (fun src -> Filesystem.copy_to_dir src dest) projFile.Project.license_file; 22 | 23 | (* copy all libs modules *) 24 | let copy_obits obits = 25 | List.iter (fun dir -> 26 | Filesystem.iterate (fun ent -> 27 | let fpath = dir ent in 28 | match Filetype.of_filepath fpath with 29 | | Filetype.FileML | Filetype.FileMLI -> Filesystem.copy_to_dir fpath dest 30 | | _ -> () 31 | ) dir) obits.target_srcdir 32 | in 33 | let copy_cbits cbits = 34 | Filesystem.iterate (fun ent -> 35 | let fpath = cbits.target_cdir ent in 36 | match Filetype.of_filepath fpath with 37 | | Filetype.FileC | Filetype.FileH -> Filesystem.copy_to_dir fpath dest 38 | | _ -> () 39 | ) cbits.target_cdir 40 | in 41 | 42 | let copy_target target = 43 | copy_obits target.target_obits; 44 | copy_cbits target.target_cbits; 45 | () 46 | in 47 | let copy_lib lib = List.iter copy_target (Project.Library.to_targets lib) in 48 | List.iter copy_lib projFile.Project.libs; 49 | List.iter (fun exe -> copy_target (Project.Executable.to_target exe)) projFile.Project.exes; 50 | List.iter (fun extra -> Filesystem.copy_to_dir extra dest) projFile.Project.extra_srcs; 51 | 52 | finally (fun () -> 53 | Unix.chdir (fp_to_string (Dist.get_path ())); 54 | Prog.runTar (fn_to_string sdistName) sdistDir 55 | ) (fun () -> Unix.chdir currentDir); 56 | 57 | verbose Report "Source tarball created: %s\n" (fp_to_string (Dist.get_path () sdistName)); 58 | () 59 | -------------------------------------------------------------------------------- /src/simple.ml: -------------------------------------------------------------------------------- 1 | (* simple builder *) 2 | open Printf 3 | open Ext.Fugue 4 | open Ext.Filepath 5 | open Ext 6 | open Obuild.Project 7 | open Obuild.Target 8 | open Obuild.Gconf 9 | open Obuild 10 | 11 | exception NoMain 12 | exception TooManyArgs 13 | 14 | let main () = 15 | let buildNative = ref true in 16 | let profiling = ref false in 17 | let debugging = ref false in 18 | let srcDir = ref currentDir in 19 | let cDir = ref currentDir in 20 | let depends = ref [] in 21 | let cpkgs = ref [] in 22 | let cfiles = ref [] in 23 | let cincludes = ref [] in 24 | let clibpaths = ref [] in 25 | let clibs = ref [] in 26 | 27 | let set_fp r v = r := fp v in 28 | let append f l v = l := f v :: !l in 29 | 30 | let append_several 31 | (f: string -> Obuild.Libname.t) 32 | (l: Obuild.Libname.t list ref) 33 | (v: string): unit = 34 | let values = string_split ',' v in 35 | let values' = List.rev_map f values in 36 | l := List.rev_append values' !l 37 | in 38 | 39 | let anonParams = ref [] in 40 | let removeDist = ref true in 41 | Arg.parse 42 | [ ("--debug", Arg.Unit (fun () -> gconf.verbosity <- DebugPlus; removeDist := false), "activate build system debug") 43 | ; ("--native", Arg.Set buildNative , "build native executable") 44 | ; ("--bytecode", Arg.Clear buildNative, "build bytecode executable") 45 | ; ("-p", Arg.Set profiling, "build with profiling") 46 | ; ("-g", Arg.Set debugging, "build with debugging") 47 | ; ("--srcdir", Arg.String (set_fp srcDir), "where to find the ML sources (default: current directory)") 48 | ; ("--cdir", Arg.String (set_fp cDir), "where to find the C sources (default: current directory)") 49 | ; ("--cinclude", Arg.String (append fp cincludes), "append one path to the C include files") 50 | ; ("--clibpath", Arg.String (append fp clibpaths), "append one path to the list of path") 51 | ; ("--clib", Arg.String (append id clibs), "append one system library") 52 | ; ("--cfile", Arg.String (append fn cfiles), "append one c file") 53 | ; ("--cpkg", Arg.String (append id cpkgs), "append one c pckage") 54 | ; ("--dep", Arg.String (append Libname.of_string depends), "append one dependency") 55 | ; ("--deps", Arg.String (append_several Libname.of_string depends), 56 | "x,y,z append dependencies x, y and z") 57 | ; ("--depends", Arg.String (append Libname.of_string depends), "append one dependency") 58 | ] 59 | (fun anon -> anonParams := anon :: !anonParams) 60 | "usage: obuild-simple [opts] main.ml"; 61 | 62 | let main = 63 | match !anonParams with 64 | | [] -> raise NoMain 65 | | [x] -> x 66 | | _ -> raise TooManyArgs 67 | in 68 | 69 | Gconf.set_target_options "executable-native" !buildNative; 70 | Gconf.set_target_options "executable-bytecode" (not !buildNative); 71 | Gconf.set_target_options "executable-profiling" (!profiling); 72 | Gconf.set_target_options "executable-debugging" (!debugging); 73 | 74 | let name = Filename.chop_extension main in 75 | let target = 76 | { target_name = Name.Exe name 77 | ; target_type = Typ.Exe 78 | ; target_cbits = 79 | { target_cdir = !cDir 80 | ; target_csources = List.rev !cfiles 81 | ; target_cflags = [] 82 | ; target_clibs = List.rev !clibs 83 | ; target_clibpaths = List.rev !clibpaths 84 | ; target_cpkgs = List.map (fun p -> (p, None)) !cpkgs (* no constraints *) 85 | } 86 | ; target_obits = { 87 | target_srcdir = [!srcDir]; 88 | target_builddeps = List.map (fun p -> (p, None)) !depends; (* no constraints *) 89 | target_oflags = []; 90 | target_pp = None; 91 | target_extradeps = []; 92 | target_stdlib = Stdlib_Standard; 93 | } 94 | ; target_buildable = BoolConst true 95 | ; target_installable = BoolConst true 96 | ; target_extras = [] 97 | } 98 | in 99 | let exe = 100 | { Executable.name = name 101 | ; Executable.main = fn main 102 | ; Executable.target = target 103 | } 104 | in 105 | let project_config = 106 | { Project.make with 107 | Project.name = name 108 | ; Project.version = "0.0.0" 109 | ; Project.obuild_ver = 1 110 | ; Project.exes = [exe] 111 | } 112 | in 113 | 114 | 115 | let file_or_link_exists fn = try let _ = Unix.lstat fn in true with _ -> false in 116 | let tmpDir = Filesystem.mktemp_dir_in "dist-" in 117 | Dist.set_path tmpDir; 118 | try 119 | finally (fun () -> 120 | Dist.create_maybe (); 121 | let _ = Dist.create_build (Dist.Autogen) in 122 | let buildDir = Dist.create_build (Dist.Target exe.Executable.target.target_name) in 123 | FindlibConf.load (); 124 | ignore(Configure.check_ocaml ()); 125 | let project = Analyze.prepare project_config [] in 126 | let bstate = Prepare.init project in 127 | Build.build_exe bstate exe; 128 | let files = Build.get_destination_files exe.Executable.target in 129 | List.iter (fun file -> 130 | printf "copying %s to %s\n" (fp_to_string (buildDir file)) (fp_to_string $ in_current_dir file); 131 | if(file_or_link_exists (fp_to_string $ in_current_dir file)) then 132 | Unix.unlink (fp_to_string $ in_current_dir file); 133 | Filesystem.copy_file (buildDir file) (in_current_dir file) 134 | ) files 135 | ) (fun () -> if !removeDist then Filesystem.removeDir tmpDir) 136 | with exn -> Exception.show exn 137 | 138 | let () = 139 | try main () 140 | with 141 | | NoMain -> eprintf "error: missing main argument, expecting one ml file as parameter\n"; exit 1 142 | | TooManyArgs -> eprintf "too many arguments, expecting just one ml file as parameter\n"; exit 1 143 | -------------------------------------------------------------------------------- /tests/dependencies/camlp4/main.ml: -------------------------------------------------------------------------------- 1 | module Test = struct 2 | type t = { 3 | t1 : string; 4 | t2 : int option; 5 | t3 : float; 6 | } with fields 7 | end 8 | 9 | -------------------------------------------------------------------------------- /tests/dependencies/camlp4/test.obuild: -------------------------------------------------------------------------------- 1 | name: test 2 | version: 0.1.0 3 | synopsis: Demo 4 | obuild-ver: 1 5 | 6 | executable test 7 | main: main.ml 8 | src-dir: . 9 | pp: camlp4o 10 | build-deps: pa_fields_conv -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/binprot.ml: -------------------------------------------------------------------------------- 1 | open Bin_prot.Std 2 | 3 | type t = { 4 | i: int; 5 | f: float 6 | } [@@deriving bin_io] 7 | 8 | let () = 9 | let x = { i = 2048 ; f = 3.1415 } in 10 | let buff = Bin_prot.Utils.bin_dump bin_writer_t x in 11 | let y = bin_read_t buff ~pos_ref:(ref 0) in 12 | assert(x = y) 13 | -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/both.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | 3 | let test () = 4 | let%lwt x = return 3 in 5 | return (x + 1 = 4) 6 | 7 | let _ = 8 | let a = [%sexp (define a "hi there!")] in 9 | Printf.printf "done\n" 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/deriving.ml: -------------------------------------------------------------------------------- 1 | 2 | type test = S of string [@@deriving show] 3 | 4 | let () = 5 | let t = S "string" in 6 | Printf.printf "%s\n" (show_test t) 7 | -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/hello.ml: -------------------------------------------------------------------------------- 1 | let _ = 2 | let a = [%sexp (define a "hi there!")] in 3 | Printf.printf "done\n" 4 | -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/hello.obuild: -------------------------------------------------------------------------------- 1 | name: hello 2 | version: 1.0 3 | obuild-ver: 1 4 | 5 | executable hello 6 | src-dir: . 7 | main-is: hello.ml 8 | build-deps: ppx_sexp 9 | 10 | executable hello_lwt 11 | src-dir: . 12 | main-is: hello_lwt.ml 13 | build-deps: lwt.ppx 14 | 15 | executable both 16 | src-dir: . 17 | main-is: both.ml 18 | build-deps: lwt.ppx, ppx_sexp 19 | 20 | executable show 21 | src-dir: . 22 | main-is: show.ml 23 | build-deps: ppx_deriving.show 24 | 25 | Executable deriving 26 | src-dir: . 27 | build-deps: ppx_deriving.std 28 | main-is: deriving.ml 29 | 30 | Executable sexp 31 | src-dir: . 32 | build-deps: ppx_sexp_conv 33 | main-is: sexp.ml 34 | 35 | Executable binprot 36 | src-dir: . 37 | build-deps: ppx_bin_prot, bin_prot 38 | main-is: binprot.ml 39 | 40 | -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/hello_lwt.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | 3 | let test () = 4 | let%lwt x = return 3 in 5 | return (x + 1 = 4) 6 | 7 | let _ = 8 | Printf.printf "Done\n" 9 | 10 | -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/main.ml: -------------------------------------------------------------------------------- 1 | open Test 2 | open Lwt 3 | 4 | let suite = suite "ppx" [ 5 | test "let" 6 | (fun () -> 7 | let%lwt x = return 3 in 8 | return (x + 1 = 4) 9 | ) ; 10 | 11 | test "nested let" 12 | (fun () -> 13 | let%lwt x = return 3 in 14 | let%lwt y = return 4 in 15 | return (x + y = 7) 16 | ) ; 17 | 18 | test "and let" 19 | (fun () -> 20 | let%lwt x = return 3 21 | and y = return 4 in 22 | return (x + y = 7) 23 | ) ; 24 | 25 | test "match" 26 | (fun () -> 27 | let x = Lwt.return (Some 3) in 28 | match%lwt x with 29 | | Some x -> return (x + 1 = 4) 30 | | None -> return false 31 | ) ; 32 | 33 | test "match-exn" 34 | (fun () -> 35 | let x = Lwt.return (Some 3) in 36 | let x' = Lwt.fail Not_found in 37 | let%lwt a = 38 | match%lwt x with 39 | | exception Not_found -> return false 40 | | Some x -> return (x = 3) 41 | | None -> return false 42 | and b = 43 | match%lwt x' with 44 | | exception Not_found -> return true 45 | | _ -> return false 46 | in 47 | Lwt.return (a && b) 48 | ) ; 49 | 50 | test "if" 51 | (fun () -> 52 | let x = Lwt.return true in 53 | let%lwt a = 54 | if%lwt x then Lwt.return_true else Lwt.return_false 55 | in 56 | let%lwt b = 57 | if%lwt x>|= not then Lwt.return_false else Lwt.return_true 58 | in 59 | (if%lwt x >|= not then Lwt.return_unit) >>= fun () -> 60 | Lwt.return (a && b) 61 | ) ; 62 | 63 | test "for" (* Test for proper sequencing *) 64 | (fun () -> 65 | let r = ref [] in 66 | let f x = 67 | let%lwt () = Lwt_unix.sleep 0.2 in Lwt.return (r := x :: !r) 68 | in 69 | let%lwt () = 70 | for%lwt x = 3 to 5 do f x done 71 | in return (!r = [5 ; 4 ; 3]) 72 | ) ; 73 | 74 | test "while" (* Test for proper sequencing *) 75 | (fun () -> 76 | let r = ref [] in 77 | let f x = 78 | let%lwt () = Lwt_unix.sleep 0.2 in Lwt.return (r := x :: !r) 79 | in 80 | let%lwt () = 81 | let c = ref 2 in 82 | while%lwt !c < 5 do incr c ; f !c done 83 | in return (!r = [5 ; 4 ; 3]) 84 | ) ; 85 | 86 | test "assert" 87 | (fun () -> 88 | let%lwt () = assert%lwt true 89 | in return true 90 | ) ; 91 | 92 | test "raise" 93 | (fun () -> 94 | Lwt.catch (fun () -> [%lwt raise Not_found]) 95 | (fun exn -> return (exn = Not_found)) 96 | ) ; 97 | 98 | test "try" 99 | (fun () -> 100 | try%lwt 101 | Lwt.fail Not_found 102 | with _ -> return true 103 | ) [@warning("@8@11")] ; 104 | 105 | test "try raise" 106 | (fun () -> 107 | try%lwt 108 | raise Not_found 109 | with _ -> return true 110 | ) [@warning("@8@11")] ; 111 | 112 | test "try fallback" 113 | (fun () -> 114 | try%lwt 115 | try%lwt 116 | Lwt.fail Not_found 117 | with Failure _ -> return false 118 | with Not_found -> return true 119 | ) [@warning("@8@11")] ; 120 | 121 | test "finally body" 122 | (fun () -> 123 | let x = ref false in 124 | begin 125 | (try%lwt 126 | return_unit 127 | with 128 | | _ -> return_unit 129 | ) [%finally x := true; return_unit] 130 | end >>= fun () -> 131 | return !x 132 | ) ; 133 | 134 | test "finally exn" 135 | (fun () -> 136 | let x = ref false in 137 | begin 138 | (try%lwt 139 | raise Not_found 140 | with 141 | | _ -> return_unit 142 | ) [%finally x := true; return_unit] 143 | end >>= fun () -> 144 | return !x 145 | ) ; 146 | 147 | test "finally exn default" 148 | (fun () -> 149 | let x = ref false in 150 | try%lwt 151 | ( raise Not_found )[%finally x := true; return_unit] 152 | >>= fun () -> 153 | return false 154 | with Not_found -> 155 | return !x 156 | ) ; 157 | 158 | test "sequence" 159 | (fun () -> 160 | let lst = ref [] in 161 | (lst := 2 :: !lst; Lwt.return_unit) >> 162 | (lst := 1 :: !lst; Lwt.return_unit) >> 163 | (Lwt.return (!lst = [1;2])) 164 | ) ; 165 | 166 | test "log" 167 | (fun () -> 168 | Lwt_log.ign_debug "bar"; 169 | Lwt_log.debug "foo" >>= fun () -> 170 | Lwt_log.info_f "baz" >>= fun () -> 171 | return_true 172 | ) ; 173 | 174 | test "structure let" 175 | (fun () -> 176 | let module M = 177 | struct 178 | let%lwt result = Lwt.return_true 179 | end 180 | in 181 | Lwt.return M.result 182 | ) ; 183 | ] 184 | 185 | let _ = Test.run "ppx" [ suite ] 186 | -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/sexp.ml: -------------------------------------------------------------------------------- 1 | open Sexplib.Std 2 | 3 | type t = { 4 | i: int; 5 | f: float 6 | } [@@deriving sexp] 7 | 8 | let () = 9 | let x = { i = 2048 ; f = 3.1415 } in 10 | let s = sexp_of_t x in 11 | let y = t_of_sexp s in 12 | assert(x = y) 13 | -------------------------------------------------------------------------------- /tests/dependencies/ppx_sexp/show.ml: -------------------------------------------------------------------------------- 1 | type point2d = float * float 2 | [@@deriving show] 3 | 4 | let _ = 5 | Printf.printf "%s\n" (show_point2d (1.1,2.2)); 6 | 7 | -------------------------------------------------------------------------------- /tests/full/autogenerated/p3.ml: -------------------------------------------------------------------------------- 1 | open Path_generated 2 | open Printf 3 | 4 | let () = 5 | printf "project version is : %s\n" project_version 6 | -------------------------------------------------------------------------------- /tests/full/autogenerated/p3.obuild: -------------------------------------------------------------------------------- 1 | name: p3 2 | version: 9.1.23 3 | obuild-ver: 1 4 | 5 | executable p3 6 | main-is: p3.ml 7 | -------------------------------------------------------------------------------- /tests/full/autopack/autopack.obuild: -------------------------------------------------------------------------------- 1 | name: autopack 2 | version: 1.0 3 | obuild-ver: 1 4 | 5 | executable autopack 6 | src-dir: src 7 | main-is: main.ml 8 | -------------------------------------------------------------------------------- /tests/full/autopack/src/a.ml: -------------------------------------------------------------------------------- 1 | let foo = "A.foo" 2 | -------------------------------------------------------------------------------- /tests/full/autopack/src/b/a.ml: -------------------------------------------------------------------------------- 1 | let foo = "B.A.foo" 2 | -------------------------------------------------------------------------------- /tests/full/autopack/src/b/c.ml: -------------------------------------------------------------------------------- 1 | let foo = "B.C.foo" 2 | let test = A.foo 3 | -------------------------------------------------------------------------------- /tests/full/autopack/src/main.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | let () = 4 | printf "A.foo: %s\n" A.foo; 5 | printf "B.A.foo: %s\n" B.A.foo; 6 | printf "B.C.foo: %s\n" B.C.foo; 7 | () 8 | -------------------------------------------------------------------------------- /tests/full/autopack2/autopack2.obuild: -------------------------------------------------------------------------------- 1 | name: autopack2 2 | version: 1.0 3 | obuild-ver: 1 4 | 5 | executable autopack2 6 | src-dir: src 7 | main-is: main.ml 8 | -------------------------------------------------------------------------------- /tests/full/autopack2/src/a.ml: -------------------------------------------------------------------------------- 1 | let foo = "A.foo" 2 | -------------------------------------------------------------------------------- /tests/full/autopack2/src/b/a.ml: -------------------------------------------------------------------------------- 1 | let foo = "B.A.foo" 2 | -------------------------------------------------------------------------------- /tests/full/autopack2/src/b/abc/foo.ml: -------------------------------------------------------------------------------- 1 | let foo = "B.Abc.Foo.foo" 2 | -------------------------------------------------------------------------------- /tests/full/autopack2/src/b/c.ml: -------------------------------------------------------------------------------- 1 | let foo = "B.C.foo" 2 | -------------------------------------------------------------------------------- /tests/full/autopack2/src/main.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | let () = 4 | printf "A.foo: %s\n" A.foo; 5 | printf "B.A.foo: %s\n" B.A.foo; 6 | printf "B.Abc.Foo.foo: %s\n" B.Abc.Foo.foo; 7 | printf "B.C.foo: %s\n" B.C.foo; 8 | () 9 | -------------------------------------------------------------------------------- /tests/full/complex/complex.obuild: -------------------------------------------------------------------------------- 1 | name: complex 2 | version: 1.0 3 | obuild-ver: 1 4 | 5 | 6 | library complex 7 | src-dir: lib 8 | modules: Math, Imaginary 9 | 10 | sub real 11 | src-dir: lib_real 12 | modules: Foo, Bar 13 | build-deps: complex 14 | 15 | executable complex 16 | src-dir: src 17 | main-is: main1.ml 18 | build-deps: complex.real 19 | 20 | executable complex2 21 | src-dir: src 22 | main-is: main.ml 23 | build-deps: complex 24 | -------------------------------------------------------------------------------- /tests/full/complex/lib/imaginary.ml: -------------------------------------------------------------------------------- 1 | 2 | let imaginary_plus t1 t2 = 3 | { Math.Types.real = Math.Accessor.get_real t1 + t2.Math.Types.real 4 | ; Math.Types.imag = t1.Math.Types.imag + Math.Accessor.get_imag t2 5 | } 6 | -------------------------------------------------------------------------------- /tests/full/complex/lib/math/accessor.ml: -------------------------------------------------------------------------------- 1 | let get_real (t: Types.t) = t.Types.real 2 | let get_imag (t: Types.t) = t.Types.imag 3 | -------------------------------------------------------------------------------- /tests/full/complex/lib/math/types.ml: -------------------------------------------------------------------------------- 1 | type t = { real : int ; imag : int } 2 | -------------------------------------------------------------------------------- /tests/full/complex/lib_real/bar.ml: -------------------------------------------------------------------------------- 1 | 2 | let real_list l = List.map Foo.make_real l 3 | -------------------------------------------------------------------------------- /tests/full/complex/lib_real/foo.ml: -------------------------------------------------------------------------------- 1 | open Math.Types 2 | 3 | let make_real x = { real = x; imag = 0 } 4 | -------------------------------------------------------------------------------- /tests/full/complex/src/main.ml: -------------------------------------------------------------------------------- 1 | open Imaginary 2 | open Math 3 | 4 | let () = 5 | let t1 = { Types.real = 0; Types.imag = 1 } in 6 | let t2 = { Types.real = 1; Types.imag = 2 } in 7 | let t3 = imaginary_plus t1 t2 in 8 | Printf.printf "real = %d\n" (Accessor.get_real t3); 9 | () 10 | -------------------------------------------------------------------------------- /tests/full/complex/src/main1.ml: -------------------------------------------------------------------------------- 1 | open Bar 2 | 3 | let () = 4 | let l = real_list [1;2;3] in 5 | List.iter 6 | (fun i -> 7 | Printf.printf "%d.%d\n" 8 | (Math.Accessor.get_real i) 9 | (Math.Accessor.get_imag i)) 10 | l 11 | -------------------------------------------------------------------------------- /tests/full/complex2/complex.obuild: -------------------------------------------------------------------------------- 1 | name: complex 2 | version: 1.0 3 | obuild-ver: 1 4 | 5 | 6 | library complex 7 | src-dir: lib,lib2 8 | modules: Math, Imaginary 9 | 10 | sub real 11 | src-dir: lib_real 12 | modules: Foo, Bar 13 | build-deps: complex 14 | 15 | executable complex 16 | src-dir: src 17 | main-is: main1.ml 18 | build-deps: complex.real 19 | 20 | executable complex2 21 | src-dir: src,src2 22 | main-is: main.ml 23 | build-deps: complex 24 | -------------------------------------------------------------------------------- /tests/full/complex2/lib/math/accessor.ml: -------------------------------------------------------------------------------- 1 | let get_real (t: Types.t) = t.Types.real 2 | let get_imag (t: Types.t) = t.Types.imag 3 | -------------------------------------------------------------------------------- /tests/full/complex2/lib/math/types.ml: -------------------------------------------------------------------------------- 1 | type t = { real : int ; imag : int } 2 | -------------------------------------------------------------------------------- /tests/full/complex2/lib2/imaginary.ml: -------------------------------------------------------------------------------- 1 | 2 | let imaginary_plus t1 t2 = 3 | { Math.Types.real = Math.Accessor.get_real t1 + t2.Math.Types.real 4 | ; Math.Types.imag = t1.Math.Types.imag + Math.Accessor.get_imag t2 5 | } 6 | -------------------------------------------------------------------------------- /tests/full/complex2/lib_real/bar.ml: -------------------------------------------------------------------------------- 1 | 2 | let real_list l = List.map Foo.make_real l 3 | -------------------------------------------------------------------------------- /tests/full/complex2/lib_real/foo.ml: -------------------------------------------------------------------------------- 1 | open Math.Types 2 | 3 | let make_real x = { real = x; imag = 0 } 4 | -------------------------------------------------------------------------------- /tests/full/complex2/src/main1.ml: -------------------------------------------------------------------------------- 1 | open Bar 2 | 3 | let () = 4 | let l = real_list [1;2;3] in 5 | List.iter 6 | (fun i -> 7 | Printf.printf "%d.%d\n" 8 | (Math.Accessor.get_real i) 9 | (Math.Accessor.get_imag i)) 10 | l 11 | -------------------------------------------------------------------------------- /tests/full/complex2/src2/main.ml: -------------------------------------------------------------------------------- 1 | open Imaginary 2 | open Math 3 | 4 | let () = 5 | let t1 = { Types.real = 0; Types.imag = 1 } in 6 | let t2 = { Types.real = 1; Types.imag = 2 } in 7 | let t3 = imaginary_plus t1 t2 in 8 | Printf.printf "real = %d\n" (Accessor.get_real t3); 9 | () 10 | -------------------------------------------------------------------------------- /tests/full/dep-uri/p2.ml: -------------------------------------------------------------------------------- 1 | open Uri 2 | open Printf 3 | 4 | let () = 5 | let u = Uri.make ~scheme:"http" ~host:"foo!.com" () in 6 | printf "%s\n" (Uri.to_string u) 7 | -------------------------------------------------------------------------------- /tests/full/dep-uri/p2.obuild: -------------------------------------------------------------------------------- 1 | name: p2 2 | version: 1.0 3 | obuild-ver: 1 4 | ocaml-version: >=3.12.1 5 | executable p2 6 | main-is: p2.ml 7 | build-deps: uri 8 | -------------------------------------------------------------------------------- /tests/full/parser/lexer.mll: -------------------------------------------------------------------------------- 1 | (* file: lexer.mll *) 2 | (* Lexical analyzer returns one of the tokens: 3 | the token NUM of a floating point number, 4 | operators (PLUS, MINUS, MULTIPLY, DIVIDE, CARET, UMINUS), 5 | or NEWLINE. It skips all blanks and tabs, unknown characters 6 | and raises End_of_file on EOF. *) 7 | { 8 | open Rpncalc (* Assumes the parser file is "rpncalc.mly". *) 9 | } 10 | let digit = ['0'-'9'] 11 | rule token = parse 12 | | [' ' '\t'] { token lexbuf } 13 | | '\n' { NEWLINE } 14 | | digit+ 15 | | "." digit+ 16 | | digit+ "." digit* as num 17 | { NUM (float_of_string num) } 18 | | '+' { PLUS } 19 | | '-' { MINUS } 20 | | '*' { MULTIPLY } 21 | | '/' { DIVIDE } 22 | | '^' { CARET } 23 | | 'n' { UMINUS } 24 | | _ { token lexbuf } 25 | | eof { raise End_of_file } 26 | -------------------------------------------------------------------------------- /tests/full/parser/main.ml: -------------------------------------------------------------------------------- 1 | (* file: main.ml *) 2 | (* Assumes the parser file is "rpncalc.mly" and the lexer file is "lexer.mll". *) 3 | let main () = 4 | try 5 | let lexbuf = Lexing.from_channel stdin in 6 | while true do 7 | Rpncalc.input Lexer.token lexbuf 8 | done 9 | with End_of_file -> exit 0 10 | 11 | let _ = Printexc.print main () 12 | -------------------------------------------------------------------------------- /tests/full/parser/parser.obuild: -------------------------------------------------------------------------------- 1 | name: parser 2 | version: 1.0 3 | obuild-ver: 1 4 | 5 | executable main 6 | main-is: main.ml 7 | -------------------------------------------------------------------------------- /tests/full/parser/rpncalc.mly: -------------------------------------------------------------------------------- 1 | /* file: rpcalc.mly */ 2 | /* Reverse polish notation calculator. */ 3 | 4 | %{ 5 | open Printf 6 | %} 7 | 8 | %token NUM 9 | %token PLUS MINUS MULTIPLY DIVIDE CARET UMINUS 10 | %token NEWLINE 11 | 12 | %start input 13 | %type input 14 | 15 | %% /* Grammar rules and actions follow */ 16 | 17 | input: /* empty */ { } 18 | | input line { } 19 | ; 20 | 21 | line: NEWLINE { } 22 | | exp NEWLINE { printf "\t%.10g\n" $1; flush stdout } 23 | ; 24 | 25 | exp: NUM { $1 } 26 | | exp exp PLUS { $1 +. $2 } 27 | | exp exp MINUS { $1 -. $2 } 28 | | exp exp MULTIPLY { $1 *. $2 } 29 | | exp exp DIVIDE { $1 /. $2 } 30 | /* Exponentiation */ 31 | | exp exp CARET { $1 ** $2 } 32 | /* Unary minus */ 33 | | exp UMINUS { -. $1 } 34 | ; 35 | %% 36 | -------------------------------------------------------------------------------- /tests/full/run: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | OBUILD=$(pwd)/../../dist/build/obuild/obuild 4 | 5 | if [ ! -x ${OBUILD} ]; then 6 | echo "obuild has not been built" 7 | exit 1 8 | fi 9 | 10 | TESTS="simple autogenerated with-c dep-uri autopack autopack2 complex complex2" 11 | if [ $# -gt 0 ]; then 12 | TESTS="$1" 13 | DEBUG="--debug+" 14 | else 15 | DEBUG="" 16 | fi 17 | 18 | RED="\033[1;31m" 19 | GREEN="\033[1;32m" 20 | BLUE="\033[1;34m" 21 | WHITE="\033[0m" 22 | 23 | for t in ${TESTS} 24 | do 25 | cd ${t} 26 | 27 | echo -e "$BLUE ==== test ${t} ====${WHITE}" 28 | ${OBUILD} clean 29 | ${OBUILD} --strict configure --enable-library-bytecode --enable-executable-bytecode --enable-library-debugging --enable-library-profiling --enable-executable-profiling --enable-executable-debugging --annot 30 | if [ $? -ne 0 ]; then 31 | echo -e "${RED}ERROR${WHITE}: configure failed" 32 | cd .. 33 | continue 34 | fi 35 | ${OBUILD} ${DEBUG} build 36 | if [ $? -ne 0 ]; then 37 | echo -e "${RED}ERROR${WHITE}: build failed" 38 | cd .. 39 | continue 40 | fi 41 | echo -e "${GREEN}SUCCESS${WHITE}: $t passed" 42 | cd .. 43 | done 44 | 45 | for t in ${TESTS} 46 | do 47 | cd ${t} 48 | ${OBUILD} clean 49 | cd .. 50 | done 51 | -------------------------------------------------------------------------------- /tests/full/simple/p1.ml: -------------------------------------------------------------------------------- 1 | let inc a = a + 1 2 | -------------------------------------------------------------------------------- /tests/full/simple/p1.obuild: -------------------------------------------------------------------------------- 1 | name: p1 2 | version: 1.0 3 | obuild-ver: 1 4 | 5 | library p1 6 | modules: P1 7 | -------------------------------------------------------------------------------- /tests/full/test/test.obuild: -------------------------------------------------------------------------------- 1 | name: test 2 | version: 0.1 3 | obuild-ver: 1 4 | 5 | library abc 6 | modules: X 7 | 8 | test abc 9 | main-is: testX.ml 10 | build-deps: abc 11 | -------------------------------------------------------------------------------- /tests/full/test/testX.ml: -------------------------------------------------------------------------------- 1 | let failed = ref false 2 | let runTest name f = 3 | let v = f () in 4 | if not v then failed := true; 5 | Printf.printf "test %s: %b\n" name v 6 | 7 | let () = 8 | runTest "foo works" (fun () -> X.foo 12 12 = 12 + 12); 9 | if !failed then exit 1 else exit 0 10 | 11 | -------------------------------------------------------------------------------- /tests/full/test/x.ml: -------------------------------------------------------------------------------- 1 | let foo a b = a + b 2 | -------------------------------------------------------------------------------- /tests/full/with-c/cbits.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | CAMLexport value stub_geti(value unit) 8 | { 9 | CAMLparam1(unit); 10 | CAMLreturn(Val_int(10)); 11 | } 12 | -------------------------------------------------------------------------------- /tests/full/with-c/ccall.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | external geti : unit -> int = "stub_geti" 4 | 5 | let inc a = a + 1 6 | 7 | let () = 8 | printf "%d\n" (inc (geti ())); 9 | () 10 | -------------------------------------------------------------------------------- /tests/full/with-c/ccall.obuild: -------------------------------------------------------------------------------- 1 | name: with-c 2 | version: 1.0 3 | obuild-ver: 1 4 | 5 | executable withc 6 | main-is: ccall.ml 7 | c-sources: cbits.c 8 | -------------------------------------------------------------------------------- /tests/simple/deps.build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ${OBUILDSIMPLE} --deps unix,str deps.ml 3 | -------------------------------------------------------------------------------- /tests/simple/deps.ml: -------------------------------------------------------------------------------- 1 | 2 | let main () = 3 | let _s = Str.quote "toto" in 4 | let _t = Unix.gettimeofday () in 5 | () 6 | ;; 7 | 8 | main () 9 | -------------------------------------------------------------------------------- /tests/simple/gtk.build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ${OBUILDSIMPLE} --cfile gtk_stubs.c --cpkg gtk+-2.0 gtk.ml 4 | -------------------------------------------------------------------------------- /tests/simple/gtk.ml: -------------------------------------------------------------------------------- 1 | external gtk_true : unit -> bool = "stub_gtk_true" 2 | 3 | let () = 4 | Printf.printf "gtk_true(): %b\n" (gtk_true ()) 5 | -------------------------------------------------------------------------------- /tests/simple/gtk_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | CAMLexport value stub_gtk_true(value unit) 10 | { 11 | CAMLparam1(unit); 12 | int b = gtk_true(); 13 | CAMLreturn(Val_int(b ? 1 : 0)); 14 | } 15 | -------------------------------------------------------------------------------- /tests/simple/hello_world.build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ${OBUILDSIMPLE} hello_world.ml 3 | -------------------------------------------------------------------------------- /tests/simple/hello_world.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Printf.printf "hello world\n"; 3 | () 4 | -------------------------------------------------------------------------------- /tests/simple/run: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | export OBUILDSIMPLE=$(pwd)/../../dist/build/obuild-simple/obuild-simple 4 | 5 | for BUILD in *.build 6 | do 7 | name=${BUILD/.build/} 8 | echo "======== $name =========================" 9 | sh ./${BUILD} 10 | if [ ! -f $name ]; then 11 | echo "[FAILED] building $name " 12 | else 13 | echo "[SUCCESS] building $name " 14 | fi 15 | done 16 | -------------------------------------------------------------------------------- /tests/simple/z.build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ${OBUILDSIMPLE} --cfile z_stubs.c --clib z z.ml 4 | -------------------------------------------------------------------------------- /tests/simple/z.ml: -------------------------------------------------------------------------------- 1 | external adler32 : int -> int = "stub_adler32" 2 | 3 | let () = 4 | let v = adler32 10 in 5 | Printf.printf "zerror 10 = %x\n" v 6 | -------------------------------------------------------------------------------- /tests/simple/z_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | CAMLexport value stub_adler32(value i) 10 | { 11 | CAMLparam1(i); 12 | 13 | /* wrong but that's fine */ 14 | unsigned int adler = adler32(0L, Z_NULL, 0); 15 | 16 | CAMLreturn(Val_int(adler)); 17 | } 18 | -------------------------------------------------------------------------------- /tests/test_dag.ml: -------------------------------------------------------------------------------- 1 | open Obuild 2 | 3 | let err = ref 0 4 | 5 | (* simple dag: a -> b -> c *) 6 | let d1 = 7 | let d = Dag.init () in 8 | Dag.addEdge "A" "B" d; 9 | Dag.addEdge "B" "C" d; 10 | d 11 | 12 | (* DAG with a fork 13 | * 14 | * A -> B -> C -> D -> E -> F 15 | * \> C'-> D'-/ 16 | *) 17 | let d2 = 18 | let d = Dag.init () in 19 | Dag.addEdgesConnected ["A";"B";"C";"D";"E";"F"] d; 20 | Dag.addEdges [ ("B","C'"); ("C'","D'"); ("D'", "E") ] d; 21 | d 22 | 23 | (* DAG 24 | * A --------> C 25 | * \-> B --/ 26 | *) 27 | let d3 = 28 | let d = Dag.init () in 29 | Dag.addEdges [("A","C"); ("A","B"); ("B","C")] d; 30 | d 31 | 32 | (* DAG 33 | * A \ /-> C 34 | * -> B 35 | * A' / \-> C' 36 | *) 37 | let d4 = 38 | let d = Dag.init () in 39 | Dag.addEdges [("A","B"); ("A'","B"); ("B","C"); ("B","C'")] d; 40 | d 41 | 42 | let showDeps prefix l = Printf.printf "%s%s\n" prefix (String.concat " -> " l) 43 | 44 | let assumeEqF f testname expected got = 45 | if f expected got 46 | then (Printf.printf "SUCCESS %s\n" testname) 47 | else (Printf.printf "FAILED %s\n" testname; showDeps "expected:" (List.concat expected); showDeps "got :" got; err := !err + 1) 48 | 49 | let assumeEq testname expected got = 50 | if expected = got 51 | then (Printf.printf "SUCCESS %s\n" testname) 52 | else (Printf.printf "FAILED %s\n" testname; showDeps "expected:" expected; showDeps "got :" got; err := !err + 1) 53 | 54 | let listEq a b = 55 | let rec loopElem l r = 56 | match l with 57 | | [] -> (true, r) 58 | | _ -> match r with 59 | | [] -> (false, r) 60 | | e::es -> 61 | if List.mem e l 62 | then loopElem (List.filter (fun z -> z <> e) l) es 63 | else (false, r) 64 | in 65 | let rec loopGroup l r = 66 | match l with 67 | | [] -> if r = [] then true else false 68 | | g::gs -> 69 | let (e,r2) = loopElem g r in 70 | if e = true 71 | then loopGroup gs r2 72 | else false 73 | in 74 | loopGroup a b 75 | 76 | let () = 77 | let l1 = Taskdep.linearize d1 Taskdep.FromParent ["A"] in 78 | let l2 = Taskdep.linearize d2 Taskdep.FromParent ["A"] in 79 | let l2' = Taskdep.linearize d2 Taskdep.FromParent ["C'"] in 80 | let l3 = Taskdep.linearize d3 Taskdep.FromParent ["A"] in 81 | let l3' = Taskdep.linearize (Dag.transitive_reduction d3) Taskdep.FromParent ["A"] in 82 | let l4 = Taskdep.linearize d4 Taskdep.FromParent ["A"; "A'"] in 83 | 84 | assumeEq "linearization A->B->C" [ "A"; "B"; "C" ] l1; 85 | assumeEq "linearization A->B->(C,C')->(D,D')->E->F" ["A";"B";"C";"D";"C'";"D'";"E";"F"] l2; 86 | assumeEq "linearization C'->D'->E->F" ["C'";"D'";"E";"F"] l2'; 87 | assumeEq "linearization A->(B->C)" ["A";"B";"C"] l3; 88 | assumeEq "linearization A->(B->C)" ["A";"B";"C"] l3'; 89 | assumeEqF listEq "linearization (A,A')->B->(C,C')" [["A";"A'"];["B"];["C";"C'"]] l4; 90 | 91 | if !err > 1 92 | then exit 1 93 | else exit 0 94 | -------------------------------------------------------------------------------- /tests/test_expr.ml: -------------------------------------------------------------------------------- 1 | open Obuild 2 | 3 | let err = ref 0 4 | 5 | let assumeEq testname expected got = 6 | if expected = got then 7 | Printf.printf "SUCCESS %s\n" testname 8 | else 9 | (Printf.printf "FAILED %s Expected %b Got %b\n" testname expected got; err := !err + 1) 10 | 11 | let expr_to_string = function 12 | | None -> "" 13 | | Some expr -> Expr.to_string expr 14 | 15 | let eval version = function 16 | | None -> true 17 | | Some expr -> Expr.eval version expr 18 | 19 | let () = 20 | let version1 = "1.7" in 21 | let version2 = "1.7.2" in 22 | let version3 = "2.0.0.0" in 23 | let version4 = "1.12.1alpha" in 24 | let (name,expr_ge) = Expr.parse_builddep "uri (>=1.7.2)" in 25 | Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ge); 26 | assumeEq ">= false" false (eval version1 expr_ge); 27 | assumeEq ">= true" true (eval version2 expr_ge); 28 | assumeEq ">= true" true (eval version3 expr_ge); 29 | assumeEq ">= true" true (eval version4 expr_ge); 30 | let (name,expr_lt) = Expr.parse_builddep "uri (<1.7.2)" in 31 | Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ge); 32 | assumeEq "< true" true (eval version1 expr_lt); 33 | assumeEq "< false" false (eval version2 expr_lt); 34 | assumeEq "< false" false (eval version3 expr_lt); 35 | assumeEq "< false" false (eval version4 expr_lt); 36 | let (name,expr_ne) = Expr.parse_builddep "uri (!=1.7.2)" in 37 | Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ne); 38 | assumeEq "!= true" true (eval version1 expr_ne); 39 | assumeEq "!= false" false (eval version2 expr_ne); 40 | assumeEq "!= true" true (eval version3 expr_ne); 41 | assumeEq "!= true" true (eval version4 expr_ne); 42 | let (name,expr_not_eq) = Expr.parse_builddep "uri !(=1.7.2)" in 43 | Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_not_eq); 44 | assumeEq "! = true" true (eval version1 expr_ne); 45 | assumeEq "! = false" false (eval version2 expr_ne); 46 | assumeEq "! = true" true (eval version3 expr_ne); 47 | assumeEq "! = true" true (eval version4 expr_ne); 48 | let (name,expr_comp) = Expr.parse_builddep "uri (<1.7.2) || (>=2.0)" in 49 | Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_comp); 50 | assumeEq "< | >= = true" true (eval version1 expr_comp); 51 | assumeEq "< | >= = false" false (eval version2 expr_comp); 52 | assumeEq "< | >= = true" true (eval version3 expr_comp); 53 | assumeEq "< | >= = false" false (eval version4 expr_comp); 54 | let (name,expr_comp2) = Expr.parse_builddep "uri ((<1.7.2) || (>=2.0) || (=1.7.2))" in 55 | Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_comp2); 56 | assumeEq "< | >= = true" true (eval version1 expr_comp2); 57 | assumeEq "< | >= = true" true (eval version2 expr_comp2); 58 | assumeEq "< | >= = true" true (eval version3 expr_comp2); 59 | assumeEq "< | >= = false" false (eval version4 expr_comp2); 60 | 61 | if !err > 1 then 62 | exit 1 63 | else 64 | exit 0 65 | 66 | -------------------------------------------------------------------------------- /tests/test_find.ml: -------------------------------------------------------------------------------- 1 | open Obuild 2 | open Ext 3 | 4 | let err = ref 0 5 | 6 | let assumeEq testname expected got = 7 | if expected = got then 8 | Printf.printf "SUCCESS %s\n" testname 9 | else 10 | (Printf.printf "FAILED %s Expected %s Got %s\n" testname expected got; err := !err + 1) 11 | 12 | let archive_to_string (ps, n) = 13 | let pres = List.map (fun p -> Meta.Predicate.to_string p) ps in 14 | Printf.sprintf "archive(%s) = [%s]" (String.concat "," pres) n 15 | 16 | let archives_to_string l = 17 | String.concat "\n" (List.map (fun a -> archive_to_string a) l) 18 | 19 | let () = 20 | let meta_unix = "requires = \"\"\n" ^ 21 | "description = \"Unix system calls\"\n" ^ 22 | "version = \"[distributed with Ocaml]\"\n" ^ 23 | "directory = \"^\"\n" ^ 24 | "browse_interfaces = \" Unit name: Unix Unit name: UnixLabels \"\n" ^ 25 | "archive(byte) = \"unix.cma\"\n" ^ 26 | "archive(native) = \"unix.cmxa\"\n" ^ 27 | "archive(byte,mt_vm) = \"vmthreads/unix.cma\"\n" 28 | in 29 | let unix = Meta.parse (Filepath.fp "unix") meta_unix "unix" in 30 | let unix_answer = Meta.Pkg.get_archive_with_filter (None, unix) (Libname.of_string "unix") 31 | [Meta.Predicate.Byte; Meta.Predicate.Gprof; Meta.Predicate.Mt] in 32 | assumeEq "unix description" "Unix system calls" unix.Meta.Pkg.description; 33 | assumeEq "unix byte" "archive(byte) = [unix.cma]" (archives_to_string unix_answer); 34 | 35 | let meta_netstring = "version = \"4.0.2\"\n" ^ 36 | "requires = \"str unix netsys \"\n" ^ 37 | "description = \"Ocamlnet - String processing library\"\n" ^ 38 | "\n" ^ 39 | "archive(byte) = \n" ^ 40 | " \"netstring.cma\"\n" ^ 41 | "archive(byte,toploop) = \n" ^ 42 | " \"netstring.cma netstring_top.cmo\"\n" ^ 43 | "archive(native) = \n" ^ 44 | " \"netstring.cmxa\"\n" ^ 45 | "archive(native,gprof) = \n" ^ 46 | " \"netstring.p.cmxa\"\n" ^ 47 | "archive(byte,-nonetaccel) +=\n" ^ 48 | " \"netaccel.cma netaccel_link.cmo\"" 49 | in 50 | let netstring = Meta.parse (Filepath.fp "netstring") meta_netstring "netstring" in 51 | Printf.printf "archives\n%s\n" (archives_to_string netstring.Meta.Pkg.archives); 52 | Printf.printf "append_archives\n%s\n" (archives_to_string netstring.Meta.Pkg.append_archives); 53 | assumeEq "netstring description" "Ocamlnet - String processing library" netstring.Meta.Pkg.description; 54 | let netstring_byte = Meta.Pkg.get_archive_with_filter (None, netstring) (Libname.of_string "netstring") 55 | [Meta.Predicate.Byte] in 56 | assumeEq "netstring byte" "archive(byte) = [netstring.cma]\narchive(byte,-nonetaccel) = [netaccel.cma netaccel_link.cmo]" (archives_to_string netstring_byte); 57 | let netstring_byte_nonetaccel = Meta.Pkg.get_archive_with_filter (None, netstring) (Libname.of_string "netstring") 58 | [Meta.Predicate.Byte; (Meta.Predicate.Unknown "nonetaccel")] in 59 | assumeEq "netstring byte nonetaccel" "archive(byte) = [netstring.cma]" (archives_to_string netstring_byte_nonetaccel); 60 | let meta_num = 61 | "# Specification for the \"num\" library:\n\ 62 | requires = \"num.core\"\n\ 63 | requires(toploop) = \"num.core,num-top\"\n\ 64 | version = \"[distributed with Ocaml]\"\n\ 65 | description = \"Arbitrary-precision rational arithmetic\"\n\ 66 | package \"core\" (\n\ 67 | \ directory = \"^\"\n\ 68 | \ version = \"[internal]\"\n\ 69 | \ 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\ 70 | \ archive(byte) = \"nums.cma\"\n\ 71 | \ archive(native) = \"nums.cmxa\"\n\ 72 | \ plugin(byte) = \"nums.cma\"\n\ 73 | \ plugin(native) = \"nums.cmxs\"\n\ 74 | )\n" in 75 | let num = Meta.parse (Filepath.fp "num") meta_num "num" in 76 | let num_answer = Meta.Pkg.get_archive_with_filter (None, num) (Libname.of_string "num.core") 77 | [Meta.Predicate.Native; Meta.Predicate.Plugin] in 78 | assumeEq "num plugin native" "archive(plugin,native) = [nums.cmxs]" (archives_to_string num_answer); 79 | let meta_threads = "# Specifications for the \"threads\" library:\n\ 80 | version = \"[distributed with Ocaml]\"\n\ 81 | description = \"Multi-threading\"\n\ 82 | requires(mt,mt_vm) = \"threads.vm\"\n\ 83 | requires(mt,mt_posix) = \"threads.posix\"\n\ 84 | directory = \"^\"\n\ 85 | type_of_threads = \"posix\"\n\ 86 | \n\ 87 | browse_interfaces = \" Unit name: Condition Unit name: Event Unit name: Mutex Unit name: Thread Unit name: ThreadUnix \"\n\ 88 | \n\ 89 | warning(-mt) = \"Linking problems may arise because of the missing -thread or -vmthread switch\"\n\ 90 | warning(-mt_vm,-mt_posix) = \"Linking problems may arise because of the missing -thread or -vmthread switch\"\n\ 91 | \n\ 92 | package \"vm\" (\n\ 93 | \ # --- Bytecode-only threads:\n\ 94 | \ requires = \"unix\"\n\ 95 | \ directory = \"+vmthreads\"\n\ 96 | \ exists_if = \"threads.cma\"\n\ 97 | \ archive(byte,mt,mt_vm) = \"threads.cma\"\n\ 98 | \ version = \"[internal]\"\n\ 99 | )\n\ 100 | \n\ 101 | package \"posix\" (\n\ 102 | \ # --- POSIX-threads:\n\ 103 | \ requires = \"unix\"\n\ 104 | \ directory = \"+threads\"\n\ 105 | \ exists_if = \"threads.cma\"\n\ 106 | \ archive(byte,mt,mt_posix) = \"threads.cma\"\n\ 107 | \ archive(native,mt,mt_posix) = \"threads.cmxa\"\n\ 108 | \ version = \"[internal]\"\n\ 109 | )\n" in 110 | let threads = Meta.parse (Filepath.fp "threads") meta_threads "threads" in 111 | let threads_answer = Meta.Pkg.get_archive_with_filter (None, threads) (Libname.of_string "threads.posix") 112 | [Meta.Predicate.Native; Meta.Predicate.Mt; Meta.Predicate.Mt_posix] in 113 | assumeEq "threads native" "archive(native,mt,mt_posix) = [threads.cmxa]" (archives_to_string threads_answer); 114 | 115 | let meta_ctypes = 116 | "\ 117 | version = \"0.4\"\n\ 118 | description = \"Combinators for binding to C libraries without writing any C.\"\n\ 119 | requires = \"unix bigarray str bytes\"\n\ 120 | archive(byte) = \"ctypes.cma\"\n\ 121 | archive(byte, plugin) = \"ctypes.cma\"\n\ 122 | archive(native) = \"ctypes.cmxa\"\n\ 123 | archive(native, plugin) = \"ctypes.cmxs\"\n\ 124 | exists_if = \"ctypes.cma\"\n\ 125 | \n\ 126 | package \"top\" (\n\ 127 | \ version = \"0.4\"\n\ 128 | \ description = \"Toplevel printers for C types\"\n\ 129 | \ requires = \"ctypes\"\n\ 130 | \ archive(byte) = \"ctypes-top.cma\"\n\ 131 | \ archive(byte, plugin) = \"ctypes-top.cma\"\n\ 132 | \ archive(native) = \"ctypes-top.cmxa\"\n\ 133 | \ archive(native, plugin) = \"ctypes-top.cmxs\"\n\ 134 | \ exists_if = \"ctypes-top.cma\"\n\ 135 | )\n\ 136 | \n\ 137 | package \"stubs\" (\n\ 138 | \ version = \"0.4\"\n\ 139 | \ description = \"Stub generation from C types\"\n\ 140 | \ requires = \"ctypes\"\n\ 141 | \ archive(byte) = \"cstubs.cma\"\n\ 142 | \ archive(byte, plugin) = \"cstubs.cma\"\n\ 143 | \ archive(native) = \"cstubs.cmxa\"\n\ 144 | \ archive(native, plugin) = \"cstubs.cmxs\"\n\ 145 | \ xen_linkopts = \"-lctypes_stubs_xen\"\n\ 146 | \ exists_if = \"cstubs.cma\"\n\ 147 | )\n\ 148 | \n\ 149 | package \"foreign\" (\n\ 150 | \ version = \"0.4\"\n\ 151 | \ description = \"Dynamic linking of C functions\"\n\ 152 | \ requires(-mt) = \"ctypes.foreign.unthreaded\"\n\ 153 | \ requires(mt) = \"ctypes.foreign.threaded\"\n\ 154 | \n\ 155 | \ package \"base\" (\n\ 156 | \ version = \"0.4\"\n\ 157 | \ description = \"Dynamic linking of C functions (base package)\"\n\ 158 | \ requires = \"ctypes\"\n\ 159 | \ archive(byte) = \"ctypes-foreign-base.cma\"\n\ 160 | \ archive(byte, plugin) = \"ctypes-foreign-base.cma\"\n\ 161 | \ archive(native) = \"ctypes-foreign-base.cmxa\"\n\ 162 | \ archive(native, plugin) = \"ctypes-foreign-base.cmxs\"\n\ 163 | \ exists_if = \"ctypes-foreign-base.cma\"\n\ 164 | \ )\n\ 165 | \n\ 166 | \ package \"threaded\" (\n\ 167 | \ version = \"0.4\"\n\ 168 | \ description = \"Dynamic linking of C functions (for use in threaded programs)\"\n\ 169 | \ requires = \"threads ctypes ctypes.foreign.base\"\n\ 170 | \ archive(byte) = \"ctypes-foreign-threaded.cma\"\n\ 171 | \ archive(byte, plugin) = \"ctypes-foreign-threaded.cma\"\n\ 172 | \ archive(native) = \"ctypes-foreign-threaded.cmxa\"\n\ 173 | \ archive(native, plugin) = \"ctypes-foreign-threaded.cmxs\"\n\ 174 | \ exists_if = \"ctypes-foreign-threaded.cma\"\n\ 175 | \ )\n\ 176 | \n\ 177 | \ package \"unthreaded\" (\n\ 178 | \ version = \"0.4\"\n\ 179 | \ description = \"Dynamic linking of C functions (for use in unthreaded programs)\"\n\ 180 | \ requires = \"ctypes ctypes.foreign.base\"\n\ 181 | \ archive(byte) = \"ctypes-foreign-unthreaded.cma\"\n\ 182 | \ archive(byte, plugin) = \"ctypes-foreign-unthreaded.cma\"\n\ 183 | \ archive(native) = \"ctypes-foreign-unthreaded.cmxa\"\n\ 184 | \ archive(native, plugin) = \"ctypes-foreign-unthreaded.cmxs\"\n\ 185 | \ exists_if = \"ctypes-foreign-unthreaded.cma\"\n\ 186 | \ )\n\ 187 | )\n\ 188 | " in 189 | let ctypes = Meta.parse (Filepath.fp "ctypes") meta_ctypes "ctypes" in 190 | Printf.printf "archives\n%s\n" (archives_to_string ctypes.Meta.Pkg.archives); 191 | Printf.printf "append_archives\n%s\n" (archives_to_string ctypes.Meta.Pkg.append_archives); 192 | 193 | if !err > 0 then 194 | exit 1 195 | else 196 | exit 0 197 | 198 | -------------------------------------------------------------------------------- /tests/test_path.ml: -------------------------------------------------------------------------------- 1 | open Obuild 2 | open Ext 3 | 4 | let err = ref 0 5 | 6 | let assumeEq testname expected got = 7 | if expected = got then 8 | Printf.printf "SUCCESS %s\n" testname 9 | else 10 | (Printf.printf "FAILED %s Expected %s Got %s\n" testname expected got; err := !err + 1) 11 | 12 | let () = 13 | let b = Filepath.fp "src/b" in 14 | let b_abc = Hier.of_string "B.Abc" in 15 | let b_b_abc = Hier.add_prefix b b_abc in 16 | 17 | assumeEq "src/b + B.Abc" "src/b" (Filepath.fp_to_string b_b_abc); 18 | (* Add_prefix src/b/abc B.Abc.Foo *) 19 | let b_abc = Filepath.fp "src/b/abc" in 20 | let b_abc_foo = Hier.of_string "B.Abc.Foo" in 21 | let b_abc_b_abc_foo = Hier.add_prefix b_abc b_abc_foo in 22 | 23 | assumeEq "src/b/abc + B.Abc.Foo" "src/b/abc" (Filepath.fp_to_string b_abc_b_abc_foo); 24 | if !err > 0 then 25 | exit 1 26 | else 27 | exit 0 28 | -------------------------------------------------------------------------------- /tools/assimilate_oasis.ml: -------------------------------------------------------------------------------- 1 | (* convert oasis file to obuild file *) 2 | open Ext.Filepath 3 | open Ext 4 | 5 | let () = 6 | ignore(Filesystem.readFile (fp "_oasis")) 7 | --------------------------------------------------------------------------------