Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

remove ocamlbuild from the compiler distribution

master
Gabriel Scherer 2015-12-26 16:08:31 +01:00
parent 58b4ae89d4
commit f8f2a6277f
226 changed files with 15 additions and 19649 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Changes
View File

@ -312,17 +312,6 @@ Other libraries:
- PR#7024: in documentation of Str regular expressions, clarify what
"end of line" means for "^" and "$" regexps.
OCamlbuild:
- PR#6794, PR#6809: pass package-specific include flags when building C files
(Jérémie Dimino, request by whitequark)
- GPR#208: add "asm" tag to ocamlbuild to enable flag -S
(ygrek)
- Changed OCamlbuild's license to LGPLv2 with static linking exception.
- GPR#219: speedup target-already-built builds
(ygrek)
- PR#6605, GPR#117: use ocamlfind, if available, to discover camlp4 path
(Vincent Laporte)
OCamldep:
- GPR#286: add support for module aliases
(jacques Garrigue)

9
INSTALL.adoc
View File

@ -14,12 +14,6 @@
are all *required*. The vendor-provided compiler, assembler and make
have major problems.
* GNU make is needed to build ocamlbuild. If your system's default
make is not GNU make, you need to define the GNUMAKE environment
variable to the name of GNU make, typically with this command:
export GNUMAKE=gmake
== INSTALLATION INSTRUCTIONS
1. Configure the system. From the top directory, do:
@ -121,7 +115,8 @@ The `configure` script accepts the following options:
Do not build ocamldoc.
-no-ocamlbuild::
Do not build ocamlbuild.
Deprecated since 4.03.0, as ocamlbuild is now distributed separately
from the compiler distribution.
-no-graph::
Do not compile the Graphics library.

2
LICENSE
View File

@ -1,7 +1,7 @@
In the following, "the Library" refers to all files marked "Copyright
INRIA" in the following directories and their sub-directories:
asmrun, byterun, config, ocamlbuild, otherlibs, stdlib, win32caml
asmrun, byterun, config, otherlibs, stdlib, win32caml
and "the Compiler" refers to all files marked "Copyright INRIA" in the
following directories and their sub-directories:

33
Makefile
View File

@ -31,7 +31,7 @@ all:
$(MAKE) runtime
$(MAKE) coreall
$(MAKE) ocaml
$(MAKE) otherlibraries $(OCAMLBUILDBYTE) $(WITH_DEBUGGER) \
$(MAKE) otherlibraries $(WITH_DEBUGGER) \
$(WITH_OCAMLDOC)
# Compile everything the first time
@ -164,7 +164,7 @@ opt:
$(MAKE) runtimeopt
$(MAKE) ocamlopt
$(MAKE) libraryopt
$(MAKE) otherlibrariesopt ocamltoolsopt $(OCAMLBUILDNATIVE)
$(MAKE) otherlibrariesopt ocamltoolsopt
# Native-code versions of the tools
opt.opt:
@ -174,12 +174,10 @@ opt.opt:
$(MAKE) ocaml
$(MAKE) opt-core
$(MAKE) ocamlc.opt
$(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC) \
$(OCAMLBUILDBYTE)
$(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC)
$(MAKE) ocamlopt.opt
$(MAKE) otherlibrariesopt
$(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt $(OCAMLDOC_OPT) \
$(OCAMLBUILDNATIVE)
$(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt $(OCAMLDOC_OPT)
base.opt:
$(MAKE) checkstack
@ -188,8 +186,7 @@ base.opt:
$(MAKE) ocaml
$(MAKE) opt-core
$(MAKE) ocamlc.opt
$(MAKE) otherlibraries $(OCAMLBUILDBYTE) $(WITH_DEBUGGER) \
$(WITH_OCAMLDOC)
$(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC)
$(MAKE) ocamlopt.opt
$(MAKE) otherlibrariesopt
@ -242,8 +239,6 @@ install:
if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKE) install); else :; fi
if test -n "$(WITH_DEBUGGER)"; then (cd debugger; $(MAKE) install); \
else :; fi
if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) install); \
else :; fi
cp config/Makefile $(INSTALL_LIBDIR)/Makefile.config
if test -f ocamlopt; then $(MAKE) installopt; else :; fi
@ -260,8 +255,6 @@ installopt:
cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(INSTALL_COMPLIBDIR)
if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKE) installopt); \
else :; fi
if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) installopt); \
else :; fi
for i in $(OTHERLIBRARIES); \
do (cd otherlibs/$$i; $(MAKE) installopt) || exit $$?; done
if test -f ocamlopt.opt ; then $(MAKE) installoptopt; fi
@ -733,20 +726,6 @@ partialclean::
alldepend::
cd debugger; $(MAKE) depend
# Ocamlbuild
ocamlbuild.byte: ocamlc otherlibraries
cd ocamlbuild && $(MAKE) all
ocamlbuild.native: ocamlopt otherlibrariesopt
cd ocamlbuild && $(MAKE) allopt
partialclean::
cd ocamlbuild && $(MAKE) clean
alldepend::
cd ocamlbuild && $(MAKE) depend
# Check that the stack limit is reasonable.
checkstack:
@ -812,7 +791,7 @@ distclean:
.PHONY: compare core coreall
.PHONY: coreboot defaultentry depend distclean install installopt
.PHONY: library library-cross libraryopt
.PHONY: ocamlbuild.byte ocamlbuild.native ocamldebugger ocamldoc
.PHONY: ocamldebugger ocamldoc
.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltoolsopt
.PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries
.PHONY: otherlibrariesopt package-macosx promote promote-cross

29
Makefile.nt
View File

@ -62,8 +62,7 @@ flexlink.opt:
# Recompile the system using the bootstrap compiler
all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml \
otherlibraries $(OCAMLBUILDBYTE) $(WITH_DEBUGGER) \
$(WITH_OCAMLDOC)
otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC)
# The compilation of ocaml will fail if the runtime has changed.
# Never mind, just do make bootstrap to reach fixpoint again.
@ -170,8 +169,8 @@ opt:
# Native-code versions of the tools
# If the submodule is initialised, then opt.opt will build a native flexlink
opt.opt: core opt-core ocamlc.opt all ocamlopt.opt ocamllex.opt \
ocamltoolsopt ocamltoolsopt.opt otherlibrariesopt $(OCAMLBUILDNATIVE) \
$(OCAMLDOC_OPT) $(if $(wildcard flexdll/Makefile),flexlink.opt)
ocamltoolsopt ocamltoolsopt.opt otherlibrariesopt $(OCAMLDOC_OPT) \
$(if $(wildcard flexdll/Makefile),flexlink.opt)
# Complete build using fast compilers
world.opt: coldstart opt.opt
@ -219,8 +218,6 @@ installbyt:
else :; fi
if test -n "$(WITH_DEBUGGER)"; then (cd debugger; $(MAKEREC) install); \
else :; fi
if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) install); \
else :; fi
if test -n "$(FLEXDLL_SUBMODULE_PRESENT)"; then $(MAKEREC) install-flexdll; \
else :; fi
cp config/Makefile $(INSTALL_LIBDIR)/Makefile.config
@ -247,8 +244,6 @@ installopt:
cp asmcomp/*.cmi asmcomp/*.cmt asmcomp/*.cmti $(INSTALL_COMPLIBDIR)
cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(INSTALL_COMPLIBDIR)
if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKEREC) installopt); fi
if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) installopt); \
else :; fi
for i in $(OTHERLIBRARIES); do \
$(MAKEREC) -C otherlibs/$$i installopt || exit $$?; \
done
@ -661,20 +656,6 @@ partialclean::
alldepend::
cd debugger; $(MAKEREC) depend
# Ocamlbuild
ocamlbuild.byte: ocamlc otherlibraries
cd ocamlbuild && $(MAKE) all
ocamlbuild.native: ocamlopt otherlibrariesopt
cd ocamlbuild && $(if $(FLEXDLL_SUBMODULE_PRESENT),OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe") $(MAKE) allopt
partialclean::
cd ocamlbuild && $(MAKE) clean
alldepend::
cd ocamlbuild && $(MAKE) depend
# Make clean in the test suite
clean::
@ -728,8 +709,8 @@ distclean:
.PHONY: partialclean beforedepend alldepend cleanboot coldstart
.PHONY: compare core coreall
.PHONY: coreboot defaultentry depend distclean install installopt
.PHONY: library library-cross libraryopt ocamlbuild-mixed-boot
.PHONY: ocamlbuild.byte ocamlbuild.native ocamldebugger ocamldoc
.PHONY: library library-cross libraryopt
.PHONY: ocamldebugger ocamldoc
.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltoolsopt
.PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries
.PHONY: otherlibrariesopt promote promote-cross

4
config/Makefile-templ
View File

@ -72,10 +72,6 @@ SHARPBANGSCRIPTS=true
# Under FreeBSD:
#CPP=cpp -P
### Magic declarations for ocamlbuild -- leave unchanged
#ml let syslib x = "-l"^x;;
#ml let mklib out files opts = Printf.sprintf "%sar rc %s %s %s; %sranlib %s" toolpref out opts files toolpref out;;
### How to invoke ranlib
RANLIB=ranlib
RANLIBCMD=ranlib

3
config/Makefile.mingw
View File

@ -20,9 +20,6 @@ PREFIX=C:/ocamlmgw
### Remove this to disable compiling ocamldebug
WITH_DEBUGGER=ocamldebugger
### Remove this to disable compiling ocamlbuild
WITH_OCAMLBUILD=ocamlbuild
### Remove this to disable compiling ocamldoc
WITH_OCAMLDOC=ocamldoc

3
config/Makefile.mingw64
View File

@ -20,9 +20,6 @@ PREFIX=C:/ocamlmgw64
### Remove this to disable compiling ocamldebug
WITH_DEBUGGER=ocamldebugger
### Remove this to disable compiling ocamlbuild
WITH_OCAMLBUILD=ocamlbuild
### Remove this to disable compiling ocamldoc
WITH_OCAMLDOC=ocamldoc

3
config/Makefile.msvc
View File

@ -166,9 +166,6 @@ PACKLD=link -lib -nologo -out:# there must be no space after this '-out:'
### Clear this to disable compiling ocamldebug
WITH_DEBUGGER=ocamldebugger
### Clear this to disable compiling ocamlbuild
WITH_OCAMLBUILD=ocamlbuild
### Clear this to disable compiling ocamldoc
WITH_OCAMLDOC=ocamldoc

3
config/Makefile.msvc64
View File

@ -170,9 +170,6 @@ PACKLD=link -lib -nologo -machine:AMD64 -out:# must have no space after '-out:'
### Clear this to disable compiling ocamldebug
WITH_DEBUGGER=ocamldebugger
### Clear this to disable compiling ocamlbuild
WITH_OCAMLBUILD=ocamlbuild
### Clear this to disable compiling ocamldoc
WITH_OCAMLDOC=ocamldoc

4
configure vendored
View File

@ -45,7 +45,6 @@ with_sharedlibs=yes
partialld="ld -r"
with_debugger=ocamldebugger
with_ocamldoc=ocamldoc
with_ocamlbuild=ocamlbuild
with_frame_pointers=false
no_naked_pointers=false
native_compiler=true
@ -155,7 +154,7 @@ while : ; do
-no-ocamldoc|--no-ocamldoc)
with_ocamldoc="";;
-no-ocamlbuild|--no-ocamlbuild)
with_ocamlbuild="";;
;; # ignored for backward compatibility
-with-frame-pointers|--with-frame-pointers)
with_frame_pointers=true;;
-no-naked-pointers|--no-naked-pointers)
@ -1802,7 +1801,6 @@ fi
echo "RUNTIMEI=${with_instrumented_runtime}" >>Makefile
echo "WITH_DEBUGGER=${with_debugger}" >>Makefile
echo "WITH_OCAMLDOC=${with_ocamldoc}" >>Makefile
echo "WITH_OCAMLBUILD=${with_ocamlbuild}" >>Makefile
echo "ASM_CFI_SUPPORTED=$asm_cfi_supported" >> Makefile
echo "WITH_FRAME_POINTERS=$with_frame_pointers" >> Makefile
echo "TARGET=$target" >> Makefile

207
ocamlbuild/.depend
View File

@ -1,207 +0,0 @@
bool.cmi :
command.cmi : tags.cmi signatures.cmi
configuration.cmi : tags.cmi pathname.cmi loc.cmi
digest_cache.cmi :
discard_printf.cmi :
display.cmi : tags.cmi
exit_codes.cmi :
fda.cmi : slurp.cmi
findlib.cmi : signatures.cmi command.cmi
flags.cmi : tags.cmi command.cmi
glob.cmi : signatures.cmi glob_ast.cmi bool.cmi
glob_ast.cmi : bool.cmi
glob_lexer.cmi : glob_ast.cmi
hooks.cmi :
hygiene.cmi : slurp.cmi
lexers.cmi : loc.cmi glob.cmi
loc.cmi :
log.cmi : tags.cmi signatures.cmi
main.cmi :
my_std.cmi : signatures.cmi
my_unix.cmi :
ocaml_arch.cmi : signatures.cmi command.cmi
ocaml_compiler.cmi : tags.cmi rule.cmi pathname.cmi command.cmi
ocaml_dependencies.cmi : pathname.cmi
ocaml_specific.cmi :
ocaml_tools.cmi : tags.cmi rule.cmi pathname.cmi command.cmi
ocaml_utils.cmi : tags.cmi pathname.cmi command.cmi
ocamlbuild.cmi :
ocamlbuild_executor.cmi :
ocamlbuild_plugin.cmi :
ocamlbuild_unix_plugin.cmi :
ocamlbuild_where.cmi :
ocamlbuildlight.cmi :
options.cmi : slurp.cmi signatures.cmi command.cmi
param_tags.cmi : tags.cmi loc.cmi
pathname.cmi : signatures.cmi
plugin.cmi :
ppcache.cmi :
report.cmi : solver.cmi
resource.cmi : slurp.cmi pathname.cmi my_std.cmi command.cmi
rule.cmi : tags.cmi resource.cmi pathname.cmi my_std.cmi command.cmi
shell.cmi :
signatures.cmi :
slurp.cmi : my_unix.cmi
solver.cmi : pathname.cmi
tags.cmi : signatures.cmi
tools.cmi : tags.cmi pathname.cmi
bool.cmo : bool.cmi
bool.cmx : bool.cmi
command.cmo : tags.cmi shell.cmi param_tags.cmi my_unix.cmi my_std.cmi \
log.cmi lexers.cmi const.cmo command.cmi
command.cmx : tags.cmx shell.cmx param_tags.cmx my_unix.cmx my_std.cmx \
log.cmx lexers.cmx const.cmx command.cmi
configuration.cmo : tags.cmi param_tags.cmi my_std.cmi log.cmi loc.cmi \
lexers.cmi glob.cmi const.cmo configuration.cmi
configuration.cmx : tags.cmx param_tags.cmx my_std.cmx log.cmx loc.cmx \
lexers.cmx glob.cmx const.cmx configuration.cmi
const.cmo :
const.cmx :
digest_cache.cmo : shell.cmi pathname.cmi options.cmi my_unix.cmi my_std.cmi \
digest_cache.cmi
digest_cache.cmx : shell.cmx pathname.cmx options.cmx my_unix.cmx my_std.cmx \
digest_cache.cmi
discard_printf.cmo : discard_printf.cmi
discard_printf.cmx : discard_printf.cmi
display.cmo : tags.cmi my_unix.cmi my_std.cmi discard_printf.cmi display.cmi
display.cmx : tags.cmx my_unix.cmx my_std.cmx discard_printf.cmx display.cmi
exit_codes.cmo : exit_codes.cmi
exit_codes.cmx : exit_codes.cmi
fda.cmo : pathname.cmi options.cmi log.cmi hygiene.cmi fda.cmi
fda.cmx : pathname.cmx options.cmx log.cmx hygiene.cmx fda.cmi
findlib.cmo : my_unix.cmi my_std.cmi lexers.cmi const.cmo command.cmi \
findlib.cmi
findlib.cmx : my_unix.cmx my_std.cmx lexers.cmx const.cmx command.cmx \
findlib.cmi
flags.cmo : tags.cmi param_tags.cmi log.cmi command.cmi bool.cmi flags.cmi
flags.cmx : tags.cmx param_tags.cmx log.cmx command.cmx bool.cmx flags.cmi
glob.cmo : my_std.cmi glob_lexer.cmi glob_ast.cmi bool.cmi glob.cmi
glob.cmx : my_std.cmx glob_lexer.cmx glob_ast.cmx bool.cmx glob.cmi
glob_ast.cmo : bool.cmi glob_ast.cmi
glob_ast.cmx : bool.cmx glob_ast.cmi
glob_lexer.cmo : glob_ast.cmi bool.cmi glob_lexer.cmi
glob_lexer.cmx : glob_ast.cmx bool.cmx glob_lexer.cmi
hooks.cmo : hooks.cmi
hooks.cmx : hooks.cmi
hygiene.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_std.cmi \
log.cmi hygiene.cmi
hygiene.cmx : slurp.cmx shell.cmx pathname.cmx options.cmx my_std.cmx \
log.cmx hygiene.cmi
lexers.cmo : my_std.cmi loc.cmi glob_ast.cmi glob.cmi bool.cmi lexers.cmi
lexers.cmx : my_std.cmx loc.cmx glob_ast.cmx glob.cmx bool.cmx lexers.cmi
loc.cmo : loc.cmi
loc.cmx : loc.cmi
log.cmo : my_unix.cmi my_std.cmi display.cmi log.cmi
log.cmx : my_unix.cmx my_std.cmx display.cmx log.cmi
main.cmo : tools.cmi tags.cmi solver.cmi slurp.cmi shell.cmi rule.cmi \
resource.cmi report.cmi plugin.cmi pathname.cmi param_tags.cmi \
options.cmi ocaml_utils.cmi ocaml_specific.cmi ocaml_dependencies.cmi \
my_unix.cmi my_std.cmi log.cmi loc.cmi lexers.cmi hooks.cmi flags.cmi \
fda.cmi exit_codes.cmi digest_cache.cmi const.cmo configuration.cmi \
command.cmi main.cmi
main.cmx : tools.cmx tags.cmx solver.cmx slurp.cmx shell.cmx rule.cmx \
resource.cmx report.cmx plugin.cmx pathname.cmx param_tags.cmx \
options.cmx ocaml_utils.cmx ocaml_specific.cmx ocaml_dependencies.cmx \
my_unix.cmx my_std.cmx log.cmx loc.cmx lexers.cmx hooks.cmx flags.cmx \
fda.cmx exit_codes.cmx digest_cache.cmx const.cmx configuration.cmx \
command.cmx main.cmi
my_std.cmo : my_std.cmi
my_std.cmx : my_std.cmi
my_unix.cmo : my_std.cmi my_unix.cmi
my_unix.cmx : my_std.cmx my_unix.cmi
ocaml_arch.cmo : pathname.cmi my_std.cmi command.cmi ocaml_arch.cmi
ocaml_arch.cmx : pathname.cmx my_std.cmx command.cmx ocaml_arch.cmi
ocaml_compiler.cmo : tools.cmi tags.cmi rule.cmi resource.cmi pathname.cmi \
options.cmi ocaml_utils.cmi ocaml_dependencies.cmi ocaml_arch.cmi \
my_std.cmi log.cmi command.cmi ocaml_compiler.cmi
ocaml_compiler.cmx : tools.cmx tags.cmx rule.cmx resource.cmx pathname.cmx \
options.cmx ocaml_utils.cmx ocaml_dependencies.cmx ocaml_arch.cmx \
my_std.cmx log.cmx command.cmx ocaml_compiler.cmi
ocaml_dependencies.cmo : tools.cmi resource.cmi pathname.cmi ocaml_utils.cmi \
my_std.cmi log.cmi ocaml_dependencies.cmi
ocaml_dependencies.cmx : tools.cmx resource.cmx pathname.cmx ocaml_utils.cmx \
my_std.cmx log.cmx ocaml_dependencies.cmi
ocaml_specific.cmo : tools.cmi tags.cmi rule.cmi pathname.cmi options.cmi \
ocamlbuild_config.cmo ocaml_utils.cmi ocaml_tools.cmi ocaml_compiler.cmi \
my_std.cmi log.cmi flags.cmi findlib.cmi configuration.cmi command.cmi \
ocaml_specific.cmi
ocaml_specific.cmx : tools.cmx tags.cmx rule.cmx pathname.cmx options.cmx \
ocamlbuild_config.cmx ocaml_utils.cmx ocaml_tools.cmx ocaml_compiler.cmx \
my_std.cmx log.cmx flags.cmx findlib.cmx configuration.cmx command.cmx \
ocaml_specific.cmi
ocaml_tools.cmo : tools.cmi tags.cmi rule.cmi pathname.cmi options.cmi \
ocaml_utils.cmi ocaml_compiler.cmi my_std.cmi flags.cmi command.cmi \
ocaml_tools.cmi
ocaml_tools.cmx : tools.cmx tags.cmx rule.cmx pathname.cmx options.cmx \
ocaml_utils.cmx ocaml_compiler.cmx my_std.cmx flags.cmx command.cmx \
ocaml_tools.cmi
ocaml_utils.cmo : tools.cmi tags.cmi pathname.cmi param_tags.cmi options.cmi \
my_std.cmi log.cmi lexers.cmi flags.cmi const.cmo command.cmi \
ocaml_utils.cmi
ocaml_utils.cmx : tools.cmx tags.cmx pathname.cmx param_tags.cmx options.cmx \
my_std.cmx log.cmx lexers.cmx flags.cmx const.cmx command.cmx \
ocaml_utils.cmi
ocamlbuild.cmo : ocamlbuild_unix_plugin.cmi ocamlbuild.cmi
ocamlbuild.cmx : ocamlbuild_unix_plugin.cmx ocamlbuild.cmi
ocamlbuild_config.cmo :
ocamlbuild_config.cmx :
ocamlbuild_executor.cmo : ocamlbuild_executor.cmi
ocamlbuild_executor.cmx : ocamlbuild_executor.cmi
ocamlbuild_plugin.cmo : ocamlbuild_plugin.cmi
ocamlbuild_plugin.cmx : ocamlbuild_plugin.cmi
ocamlbuild_unix_plugin.cmo : ocamlbuild_executor.cmi my_unix.cmi my_std.cmi \
exit_codes.cmi ocamlbuild_unix_plugin.cmi
ocamlbuild_unix_plugin.cmx : ocamlbuild_executor.cmx my_unix.cmx my_std.cmx \
exit_codes.cmx ocamlbuild_unix_plugin.cmi
ocamlbuild_where.cmo : ocamlbuild_config.cmo ocamlbuild_where.cmi
ocamlbuild_where.cmx : ocamlbuild_config.cmx ocamlbuild_where.cmi
ocamlbuildlight.cmo : ocamlbuildlight.cmi
ocamlbuildlight.cmx : ocamlbuildlight.cmi
options.cmo : shell.cmi ocamlbuild_where.cmi ocamlbuild_config.cmo \
my_std.cmi log.cmi lexers.cmi const.cmo command.cmi options.cmi
options.cmx : shell.cmx ocamlbuild_where.cmx ocamlbuild_config.cmx \
my_std.cmx log.cmx lexers.cmx const.cmx command.cmx options.cmi
param_tags.cmo : tags.cmi my_std.cmi log.cmi loc.cmi lexers.cmi \
param_tags.cmi
param_tags.cmx : tags.cmx my_std.cmx log.cmx loc.cmx lexers.cmx \
param_tags.cmi
pathname.cmo : shell.cmi options.cmi my_unix.cmi my_std.cmi log.cmi glob.cmi \
pathname.cmi
pathname.cmx : shell.cmx options.cmx my_unix.cmx my_std.cmx log.cmx glob.cmx \
pathname.cmi
plugin.cmo : tools.cmi tags.cmi shell.cmi rule.cmi pathname.cmi \
param_tags.cmi options.cmi ocamlbuild_where.cmi my_unix.cmi my_std.cmi \
log.cmi const.cmo command.cmi plugin.cmi
plugin.cmx : tools.cmx tags.cmx shell.cmx rule.cmx pathname.cmx \
param_tags.cmx options.cmx ocamlbuild_where.cmx my_unix.cmx my_std.cmx \
log.cmx const.cmx command.cmx plugin.cmi
ppcache.cmo : shell.cmi pathname.cmi my_std.cmi log.cmi command.cmi \
ppcache.cmi
ppcache.cmx : shell.cmx pathname.cmx my_std.cmx log.cmx command.cmx \
ppcache.cmi
report.cmo : solver.cmi resource.cmi my_std.cmi log.cmi glob.cmi report.cmi
report.cmx : solver.cmx resource.cmx my_std.cmx log.cmx glob.cmx report.cmi
resource.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_unix.cmi \
my_std.cmi log.cmi lexers.cmi glob_ast.cmi glob.cmi digest_cache.cmi \
const.cmo command.cmi resource.cmi
resource.cmx : slurp.cmx shell.cmx pathname.cmx options.cmx my_unix.cmx \
my_std.cmx log.cmx lexers.cmx glob_ast.cmx glob.cmx digest_cache.cmx \
const.cmx command.cmx resource.cmi
rule.cmo : shell.cmi resource.cmi pathname.cmi options.cmi my_std.cmi \
log.cmi digest_cache.cmi command.cmi rule.cmi
rule.cmx : shell.cmx resource.cmx pathname.cmx options.cmx my_std.cmx \
log.cmx digest_cache.cmx command.cmx rule.cmi
shell.cmo : tags.cmi my_unix.cmi my_std.cmi log.cmi shell.cmi
shell.cmx : tags.cmx my_unix.cmx my_std.cmx log.cmx shell.cmi
slurp.cmo : my_unix.cmi my_std.cmi slurp.cmi
slurp.cmx : my_unix.cmx my_std.cmx slurp.cmi
solver.cmo : rule.cmi resource.cmi pathname.cmi my_std.cmi log.cmi \
command.cmi solver.cmi
solver.cmx : rule.cmx resource.cmx pathname.cmx my_std.cmx log.cmx \
command.cmx solver.cmi
tags.cmo : tags.cmi
tags.cmx : tags.cmi
tools.cmo : tags.cmi rule.cmi pathname.cmi my_std.cmi log.cmi \
configuration.cmi tools.cmi
tools.cmx : tags.cmx rule.cmx pathname.cmx my_std.cmx log.cmx \
configuration.cmx tools.cmi

2
ocamlbuild/AUTHORS
View File

@ -1,2 +0,0 @@
Nicolas Pouillard
Berke Durak

3621
ocamlbuild/ChangeLog
View File

File diff suppressed because it is too large Load Diff

35
ocamlbuild/FAQ
View File

@ -1,35 +0,0 @@
Q: I've a directory with examples and I want build all of them easily?
R:
You can use an .itarget file listing all products that you want.
$ cat examples.itarget
examples/a.byte
examples/b.byte
$ ocamlbuild examples.otarget
You can also have a dynamic rule that read the examples directory:
$ cat myocamlbuild.ml
open Ocamlbuild_plugin;;
dispatch begin function
| After_rules ->
let examples =
Array.fold_right begin fun f acc ->
if Pathname.get_extension f = "ml" then
("examples" / Pathname.update_extension "byte" f) :: acc
else
acc
end (Pathname.readdir "examples") []
in
rule "All examples"
~prod:"examples.otarget"
~deps:examples
(fun _ _ -> Command.Nop)
| _ -> ()
end
$ ocamlbuild examples.otarget

214
ocamlbuild/Makefile
View File

@ -1,214 +0,0 @@
#########################################################################
# #
# OCaml #
# #
# Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt #
# #
# Copyright 2007 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the GNU Library General Public License, with #
# the special exception on linking described in file ../LICENSE. #
# #
#########################################################################
include ../config/Makefile
CAMLRUN ?= ../boot/ocamlrun
CAMLYACC ?= ../boot/ocamlyacc
ROOTDIR = ..
OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep
OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
CP = cp
COMPFLAGS= -warn-error A -w L -w R -w Z -I ../otherlibs/$(UNIXLIB) -safe-string
LINKFLAGS= -I ../otherlibs/$(UNIXLIB)
PACK_CMO=\
const.cmo \
loc.cmo \
discard_printf.cmo \
signatures.cmi \
my_std.cmo \
my_unix.cmo \
tags.cmo \
display.cmo \
log.cmo \
shell.cmo \
bool.cmo \
glob_ast.cmo \
glob_lexer.cmo \
glob.cmo \
lexers.cmo \
param_tags.cmo \
command.cmo \
ocamlbuild_config.cmo \
ocamlbuild_where.cmo \
slurp.cmo \
options.cmo \
pathname.cmo \
configuration.cmo \
flags.cmo \
hygiene.cmo \
digest_cache.cmo \
resource.cmo \
rule.cmo \
solver.cmo \
report.cmo \
tools.cmo \
fda.cmo \
findlib.cmo \
ocaml_arch.cmo \
ocaml_utils.cmo \
ocaml_dependencies.cmo \
ocaml_compiler.cmo \
ocaml_tools.cmo \
ocaml_specific.cmo \
plugin.cmo \
exit_codes.cmo \
hooks.cmo \
main.cmo
EXTRA_CMO=\
ocamlbuild_plugin.cmo \
ocamlbuild_executor.cmo \
ocamlbuild_unix_plugin.cmo
PACK_CMX=$(PACK_CMO:.cmo=.cmx)
EXTRA_CMX=$(EXTRA_CMO:.cmo=.cmx)
EXTRA_CMI=$(EXTRA_CMO:.cmo=.cmi)
INSTALL_LIB=\
ocamlbuildlib.cma \
ocamlbuild.cmo \
ocamlbuild_pack.cmi \
$(EXTRA_CMO:.cmo=.cmi)
INSTALL_LIB_OPT=\
ocamlbuildlib.cmxa ocamlbuildlib.$(A) \
ocamlbuild.cmx ocamlbuild.$(O) \
ocamlbuild_pack.cmx \
$(EXTRA_CMO:.cmo=.cmx) $(EXTRA_CMO:.cmo=.$(O))
INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR)/ocamlbuild
INSTALL_BINDIR=$(DESTDIR)$(BINDIR)
all: ocamlbuild.byte ocamlbuildlib.cma
# ocamlbuildlight.byte ocamlbuildlightlib.cma
allopt: ocamlbuild.native ocamlbuildlib.cmxa
# The executables
ocamlbuild.byte: ocamlbuild_pack.cmo $(EXTRA_CMO) ocamlbuild.cmo
$(OCAMLC) $(LINKFLAGS) -o ocamlbuild.byte \
unix.cma ocamlbuild_pack.cmo $(EXTRA_CMO) ocamlbuild.cmo
ocamlbuildlight.byte: ocamlbuild_pack.cmo ocamlbuildlight.cmo
$(OCAMLC) $(LINKFLAGS) -o ocamlbuildlight.byte \
ocamlbuild_pack.cmo ocamlbuildlight.cmo
ocamlbuild.native: ocamlbuild_pack.cmx $(EXTRA_CMX) ocamlbuild.cmx
$(OCAMLOPT) $(LINKFLAGS) -o ocamlbuild.native \
unix.cmxa ocamlbuild_pack.cmx $(EXTRA_CMX) ocamlbuild.cmx
# The libraries
ocamlbuildlib.cma: ocamlbuild_pack.cmo $(EXTRA_CMO)
$(OCAMLC) -a -o ocamlbuildlib.cma \
ocamlbuild_pack.cmo $(EXTRA_CMO)
ocamlbuildlightlib.cma: ocamlbuild_pack.cmo ocamlbuildlight.cmo
$(OCAMLC) -a -o ocamlbuildlightlib.cma \
ocamlbuild_pack.cmo ocamlbuildlight.cmo
ocamlbuildlib.cmxa: ocamlbuild_pack.cmx $(EXTRA_CMX)
$(OCAMLOPT) -a -o ocamlbuildlib.cmxa \
ocamlbuild_pack.cmx $(EXTRA_CMX)
# The packs
ocamlbuild_pack.cmo: $(PACK_CMO)
$(OCAMLC) -pack $(PACK_CMO) -o ocamlbuild_pack.cmo
ocamlbuild_pack.cmi: ocamlbuild_pack.cmo
ocamlbuild_pack.cmx: $(PACK_CMX)
$(OCAMLOPT) -pack $(PACK_CMX) -o ocamlbuild_pack.cmx
# The config file
ocamlbuild_config.ml: ../config/Makefile
(echo 'let bindir = "$(BINDIR)"'; \
echo 'let libdir = "$(LIBDIR)"'; \
echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\
echo 'let a = "$(A)"'; \
echo 'let o = "$(O)"'; \
echo 'let so = "$(SO)"'; \
echo 'let ext_dll = "$(EXT_DLL)"'; \
echo 'let exe = "$(EXE)"'; \
) > ocamlbuild_config.ml
clean::
rm -f ocamlbuild_config.ml
beforedepend:: ocamlbuild_config.ml
# The lexers
lexers.ml: lexers.mll
$(OCAMLLEX) lexers.mll
clean::
rm -f lexers.ml
beforedepend:: lexers.ml
glob_lexer.ml: glob_lexer.mll
$(OCAMLLEX) glob_lexer.mll
clean::
rm -f glob_lexer.ml
beforedepend:: glob_lexer.ml
# Installation
install:
$(CP) ocamlbuild.byte $(INSTALL_BINDIR)/ocamlbuild$(EXE)
$(CP) ocamlbuild.byte $(INSTALL_BINDIR)/ocamlbuild.byte$(EXE)
mkdir -p $(INSTALL_LIBDIR)
$(CP) $(INSTALL_LIB) $(INSTALL_LIBDIR)/
installopt:
if test -f ocamlbuild.native; then $(MAKE) installopt_really; fi
installopt_really:
$(CP) ocamlbuild.native $(INSTALL_BINDIR)/ocamlbuild$(EXE)
$(CP) ocamlbuild.native $(INSTALL_BINDIR)/ocamlbuild.native$(EXE)
mkdir -p $(INSTALL_LIBDIR)
$(CP) $(INSTALL_LIB_OPT) $(INSTALL_LIBDIR)/
# The generic rules
.SUFFIXES: .ml .mli .cmo .cmi .cmx
.ml.cmo:
$(OCAMLC) $(COMPFLAGS) -c $<
.mli.cmi:
$(OCAMLC) $(COMPFLAGS) -c $<
.ml.cmx:
$(OCAMLOPT) -for-pack Ocamlbuild_pack $(COMPFLAGS) -c $<
clean::
rm -f *.cm? *.$(O) *.cmxa *.$(A)
rm -f *.byte *.native
# The dependencies
depend: beforedepend
$(OCAMLDEP) *.mli *.ml > .depend
$(EXTRA_CMI): ocamlbuild_pack.cmi
$(EXTRA_CMO): ocamlbuild_pack.cmo ocamlbuild_pack.cmi
$(EXTRA_CMX): ocamlbuild_pack.cmx ocamlbuild_pack.cmi
include .depend
.PHONY: all allopt clean beforedepend
.PHONY: install installopt installopt_really depend

38
ocamlbuild/TODO
View File

@ -1,38 +0,0 @@
To do:
* Add rules for producing .recdepends from .ml, .mli, .mllib, .mlpack
* Produce a dependency subgraph when failing on circular deps (e.g. "A: B C\nB: D")
* Executor: exceptional conditions and Not_found
* Fix report
* Design a nice, friendly, future-proof plugin (myocamlbuild) API
* Ocamlbuild should keep track of files removed from the source directory, e.g.,
removing a .mli should be mirrored in the _build directory.
Being done:
* Write doc
Almost done:
* Fine control for hygiene using a glob pattern (command line option + tag)
=> the command line option is todo.
-tag "<glob1> or <glob2> ..." "tag1, -tag2, ..."
Won't fix:
* Config file for options => no since myocamlbuild is sufficent
* Optimize MD5 (Daemon ? Dnotify ?) : too much hassle for little gain
Done:
* Fix uncaught exception handler to play well with the Display module
* Finish display before executing target
* Slurp: in a directory read files, before subdirs (to have _tags before foo/_tags)
* Add a -clean option
* Add ocamldoc rules (use .odoc extension)
* Add .inferred.mli target rules
* -- with no args does not call the executable
* Complain when used with -- and no target
* dep ["ocaml"; "link"; "use_foo"] ["foo/foo.o"] tags for adding targets
* Ensure that _build and _log are not created if not needed (with -help for
instance)
* Display: should display nothing (even when finish is called) when no real
event as occured.
* Have some option to draw tags/rules that applies on a target (it's -show-tags).
* rm sanitize.sh during -clean
* rm sanitize.sh when running ocamlbuild

23
ocamlbuild/_tags
View File

@ -1,23 +0,0 @@
#########################################################################
# #
# OCaml #
# #
# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt #
# #
# Copyright 2007 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the GNU Library General Public License, with #
# the special exception on linking described in file ../LICENSE. #
# #
#########################################################################
# OCamlbuild tags file
true: debug
<*.ml> or <*.mli>: warn_L, warn_R, warn_Z, annot
"discard_printf.ml": rectypes
"ocamlbuildlib.cma" or "ocamlbuildlightlib.cma": linkall
<*.byte> or <*.native> or <*.top>: use_unix
"ocamlbuildlight.byte": -use_unix, nopervasives
<*.cmx>: for-pack(Ocamlbuild_pack)
<{ocamlbuild_{pack,unix_plugin,plugin,executor},ppcache}{,.p}.cmx>: -for-pack(Ocamlbuild_pack)
"doc": not_hygienic

40
ocamlbuild/bool.ml
View File

@ -1,40 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Bool *)
type 'a boolean = And of 'a boolean list | Or of 'a boolean list | Not of 'a boolean | Atom of 'a | True | False;;
let rec eval f = function
| And l -> List.for_all (eval f) l
| Or l -> List.exists (eval f) l
| Not x -> not (eval f x)
| Atom a -> f a
| True -> true
| False -> false
;;
let rec iter f = function
| (And l|Or l) -> List.iter (iter f) l
| Not x -> iter f x
| Atom a -> f a
| True|False -> ()
;;
let rec map f = function
| And l -> And(List.map (map f) l)
| Or l -> Or(List.map (map f) l)
| Not x -> Not(map f x)
| Atom a -> Atom(f a)
| (True|False) as b -> b
;;

36
ocamlbuild/bool.mli
View File

@ -1,36 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Bool *)
(** Provides a datatype for representing boolean formulas and evaluation,
iteration and map functions. *)
(** Public type for generic boolean formulas. An empty conjunction [And[]] is true and
an empty disjunction [Or[]] is false. *)
type 'a boolean =
And of 'a boolean list
| Or of 'a boolean list
| Not of 'a boolean
| Atom of 'a
| True
| False
val eval : ('a -> bool) -> 'a boolean -> bool
(** [eval g f] evaluates the boolean formula [f] using the values returned by [g] for the atoms. *)
val iter : ('a -> unit) -> 'a boolean -> unit
(** [iter g f] calls [g] over every atom of [f]. *)
val map : ('a -> 'b) -> 'a boolean -> 'b boolean
(** [map g f] replaces every atom of [f] by its image by [g]. *)

423
ocamlbuild/command.ml
View File

@ -1,423 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(* Command *)
open My_std
open Log
type tags = Tags.t
type pathname = string
let jobs = ref 1
type t =
| Seq of t list
| Cmd of spec
| Echo of string list * pathname
| Nop
and spec =
| N (* nop or nil *)
| S of spec list
| A of string
| P of pathname
| Px of pathname
| Sh of string
| T of Tags.t
| V of string
| Quote of spec
(*type v = [ `Seq of v list | `Cmd of vspec | `Nop ]
and vspec =
[ `N
| `S of vspec list
| `A of string
| `P of pathname
| `Px of pathname
| `Sh of string
| `Quote of vspec ]
let rec spec_of_vspec =
function
| `N -> N
| `S vspecs -> S (List.map spec_of_vspec vspecs)
| `A s -> A s
| `P s -> P s
| `Px s -> Px s
| `Sh s -> Sh s
| `Quote vspec -> Quote (spec_of_vspec vspec)
let rec vspec_of_spec =
function
| N -> `N
| S specs -> `S (List.map vspec_of_spec specs)
| A s -> `A s
| P s -> `P s
| Px s -> `Px s
| Sh s -> `Sh s
| T _ -> invalid_arg "vspec_of_spec: T not supported"
| Quote spec -> `Quote (vspec_of_spec spec)
let rec t_of_v =
function
| `Nop -> Nop
| `Cmd vspec -> Cmd (spec_of_vspec vspec)
| `Seq cmds -> Seq (List.map t_of_v cmds)
let rec v_of_t =
function
| Nop -> `Nop
| Cmd spec -> `Cmd (vspec_of_spec spec)
| Seq cmds -> `Seq (List.map v_of_t cmds)*)
let no_tag_handler _ = failwith "no_tag_handler"
let tag_handler = ref no_tag_handler
(*** atomize *)
let atomize l = S(List.map (fun x -> A x) l)
let atomize_paths l = S(List.map (fun x -> P x) l)
(* ***)
let env_path = lazy begin
let path_var = Sys.getenv "PATH" in
let parse_path =
if Sys.os_type = "Win32" then
Lexers.parse_environment_path_w
else
Lexers.parse_environment_path
in
let paths =
parse_path Const.Source.path (Lexing.from_string path_var) in
let norm_current_dir_name path =
if path = "" then Filename.current_dir_name else path
in
List.map norm_current_dir_name paths
end
let virtual_solvers = Hashtbl.create 32
let setup_virtual_command_solver virtual_command solver =
Hashtbl.replace virtual_solvers virtual_command solver
let virtual_solver virtual_command =
let solver =
try
Hashtbl.find virtual_solvers virtual_command
with Not_found ->
failwith (sbprintf "no solver for the virtual command %S \
(setup one with Command.setup_virtual_command_solver)"
virtual_command)
in
try solver ()
with Not_found ->
failwith (Printf.sprintf "the solver for the virtual command %S \
has failed finding a valid command" virtual_command)
(* On Windows, we need to also check for the ".exe" version of the file. *)
let file_or_exe_exists file =
sys_file_exists file || ((Sys.win32 || Sys.cygwin) && sys_file_exists (file ^ ".exe"))
let search_in_path cmd =
(* Try to find [cmd] in path [path]. *)
let try_path path =
(* Don't know why we're trying to be subtle here... *)
if path = Filename.current_dir_name then file_or_exe_exists cmd
else file_or_exe_exists (filename_concat path cmd)
in
if Filename.is_implicit cmd then
let path = List.find try_path !*env_path in
(* We're not trying to append ".exe" here because all windows shells are
* capable of understanding the command without the ".exe" suffix. *)
filename_concat path cmd
else
cmd
(*** string_of_command_spec{,_with_calls *)
let rec string_of_command_spec_with_calls call_with_tags call_with_target resolve_virtuals spec =
let self = string_of_command_spec_with_calls call_with_tags call_with_target resolve_virtuals in
let b = Buffer.create 256 in
(* The best way to prevent bash from switching to its windows-style
* quote-handling is to prepend an empty string before the command name. *)
if Sys.os_type = "Win32" then
Buffer.add_string b "''";
let first = ref true in
let put_space () =
if !first then
first := false
else
Buffer.add_char b ' '
in
let put_filename p =
Buffer.add_string b (Shell.quote_filename_if_needed p)
in
let rec do_spec = function
| N -> ()
| A u -> put_space (); put_filename u
| Sh u -> put_space (); Buffer.add_string b u
| P p -> put_space (); put_filename p
| Px u -> put_space (); put_filename u; call_with_target u
| V v -> if resolve_virtuals then do_spec (virtual_solver v)
else (put_space (); Printf.bprintf b "<virtual %s>" (Shell.quote_filename_if_needed v))
| S l -> List.iter do_spec l
| T tags -> call_with_tags tags; do_spec (!tag_handler tags)
| Quote s -> put_space (); put_filename (self s)
in
do_spec spec;
Buffer.contents b
let string_of_command_spec x = string_of_command_spec_with_calls ignore ignore false x
let string_target_and_tags_of_command_spec spec =
let rtags = ref Tags.empty in
let rtarget = ref "" in
let union_rtags tags = rtags := Tags.union !rtags tags in
let s = string_of_command_spec_with_calls union_rtags ((:=) rtarget) true spec in
let target = if !rtarget = "" then s else !rtarget in
s, target, !rtags
let string_print_of_command_spec spec quiet pretend =
let s, target, tags = string_target_and_tags_of_command_spec spec in
fun () -> if not quiet then Log.event ~pretend s target tags; s
(* ***)
let print_escaped_string f = Format.fprintf f "%S"
let rec print f =
function
| Cmd spec -> Format.pp_print_string f (string_of_command_spec spec)
| Seq seq -> List.print print f seq
| Nop -> Format.pp_print_string f "nop"
| Echo(texts, dest_path) ->
Format.fprintf f "@[<2>Echo(%a,@ %a)@]"
(List.print print_escaped_string) texts print_escaped_string dest_path
let to_string x = sbprintf "%a" print x
let add_parallel_stat, dump_parallel_stats =
let xmin = ref max_int in
let xmax = ref 0 in
let xsum = ref 0 in
let xsumall = ref 0 in
let xcount = ref 0 in
let xcountall = ref 0 in
let add_parallel_stat x =
if x > 0 then begin
incr xcountall;
xsumall := x + !xsumall;
end;
if x > 1 then begin
incr xcount;
xsum := x + !xsum;
xmax := max !xmax x;
xmin := min !xmin x;
end
in
let dump_parallel_stats () =
if !jobs <> 1 then
if !xcount = 0 then
dprintf 1 "# No parallelism done"
else
let xaverage = float_of_int !xsumall /. float_of_int !xcountall in
let xaveragepara = float_of_int !xsum /. float_of_int !xcount in
dprintf 1 "# Parallel statistics: { count(total): %d(%d), max: %d, min: %d, average(total): %.3f(%.3f) }"
!xcount !xcountall !xmax !xmin xaveragepara xaverage
in
add_parallel_stat, dump_parallel_stats
module Primitives = struct
let do_echo texts dest_path =
with_output_file dest_path begin fun oc ->
List.iter (output_string oc) texts
end
let echo x y () = (* no print here yet *) do_echo x y; ""
end
let rec list_rev_iter f =
function
| [] -> ()
| x :: xs -> list_rev_iter f xs; f x
let flatten_commands quiet pretend cmd =
let rec loop acc =
function
| [] -> acc
| Nop :: xs -> loop acc xs
| Cmd spec :: xs -> loop (string_print_of_command_spec spec quiet pretend :: acc) xs
| Echo(texts, dest_path) :: xs -> loop (Primitives.echo texts dest_path :: acc) xs
| Seq l :: xs -> loop (loop acc l) xs
in List.rev (loop [] [cmd])
let execute_many ?(quiet=false) ?(pretend=false) cmds =
add_parallel_stat (List.length cmds);
let degraded = !*My_unix.is_degraded || Sys.os_type = "Win32" in
let jobs = !jobs in
if jobs < 0 then invalid_arg "jobs < 0";
let max_jobs = if jobs = 0 then None else Some jobs in
let ticker = Log.update in
let display = Log.display in
if cmds = [] then
None
else
begin
let konts = List.map (flatten_commands quiet pretend) cmds in
if pretend then
begin
List.iter (List.iter (fun f -> ignore (f ()))) konts;
None
end
else
begin
reset_filesys_cache ();
if degraded then
let res, opt_exn =
List.fold_left begin fun (acc_res, acc_exn) cmds ->
match acc_exn with
| None ->
begin try
List.iter begin fun action ->
let cmd = action () in
let rc = sys_command cmd in
if rc <> 0 then begin
if not quiet then
eprintf "Exit code %d while executing this \
command:@\n%s" rc cmd;
raise (Exit_with_code rc)
end
end cmds;
true :: acc_res, None
with e -> false :: acc_res, Some e
end
| Some _ -> false :: acc_res, acc_exn
end ([], None) konts
in match opt_exn with
| Some(exn) -> Some(List.rev res, exn)
| None -> None
else
My_unix.execute_many ~ticker ?max_jobs ~display konts
end
end
;;
let execute ?quiet ?pretend cmd =
match execute_many ?quiet ?pretend [cmd] with
| Some(_, exn) -> raise exn
| _ -> ()
let iter_tags f x =
let rec spec x =
match x with
| N | A _ | Sh _ | P _ | Px _ | V _ | Quote _ -> ()
| S l -> List.iter spec l
| T tags -> f tags
in
let rec cmd x =
match x with
| Nop | Echo _ -> ()
| Cmd(s) -> spec s
| Seq(s) -> List.iter cmd s in
cmd x
let fold_pathnames f x =
let rec spec = function
| N | A _ | Sh _ | V _ | Quote _ | T _ -> fun acc -> acc
| P p | Px p -> f p
| S l -> List.fold_right spec l
in
let rec cmd = function
| Nop -> fun acc -> acc
| Echo(_, p) -> f p
| Cmd(s) -> spec s
| Seq(s) -> List.fold_right cmd s in
cmd x
let rec reduce x =
let rec self x acc =
match x with
| N -> acc
| A _ | Sh _ | P _ | Px _ | V _ -> x :: acc
| S l -> List.fold_right self l acc
| T tags -> self (!tag_handler tags) acc
| Quote s -> Quote (reduce s) :: acc in
match self x [] with
| [] -> N
| [x] -> x
| xs -> S xs
let digest =
let list = List.fold_right in
let text x acc = Digest.string x :: acc in
let rec cmd =
function
| Cmd spec -> fun acc -> string_of_command_spec spec :: acc
| Seq seq -> list cmd seq
| Nop -> fun acc -> acc
| Echo(texts, dest_path) -> list text (dest_path :: texts)
in
fun x ->
match cmd x [] with
| [x] -> x
| xs -> Digest.string ("["^String.concat ";" xs^"]")
let all_deps_of_tags = ref []
let cons deps acc =
List.rev&
List.fold_left begin fun acc dep ->
if List.mem dep acc then acc else dep :: acc
end acc deps
let deps_of_tags tags =
List.fold_left begin fun acc (xtags, xdeps) ->
if Tags.does_match tags xtags then cons xdeps acc
else acc
end [] !all_deps_of_tags
let set_deps_of_tags tags deps =
all_deps_of_tags := (tags, deps) :: !all_deps_of_tags
let dep tags deps = set_deps_of_tags (Tags.of_list tags) deps
let pdep tags ptag deps =
Param_tags.declare ptag
(fun param -> dep (Param_tags.make ptag param :: tags) (deps param))
let list_all_deps () =
!all_deps_of_tags
(*
let to_string_for_digest x =
let rec cmd_of_spec =
function
| [] -> None
| N :: xs -> cmd_of_spec xs
| (A x | P x | P x) :: _ -> Some x
| Sh x :: _ ->
if Shell.is_simple_filename x then Some x
else None (* Sh"ocamlfind ocamlc" for example will not be digested. *)
| S specs1 :: specs2 -> cmd_of_spec (specs1 @ specs2)
| (T _ | Quote _) :: _ -> assert false in
let rec cmd_of_cmds =
function
| Nop | Seq [] -> None
| Cmd spec -> cmd_of_spec [spec]
| Seq (cmd :: _) -> cmd_of_cmds cmd in
let s = to_string x in
match cmd_of_cmds x with
| Some x ->
if sys_file_exists x then sprintf "(%S,%S)" s (Digest.file x)
else s
| None -> s
*)

52
ocamlbuild/command.mli
View File

@ -1,52 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(* Command *)
(** Provides an abstract type for easily building complex shell commands without making
quotation mistakes. *)
include Signatures.COMMAND with type tags = Tags.t and type pathname = string
(** {6 For system use only, not for the casual user} *)
val string_target_and_tags_of_command_spec : spec -> string * string * Tags.t
val iter_tags : (Tags.t -> unit) -> t -> unit
val fold_pathnames : (pathname -> 'a -> 'a) -> t -> 'a -> 'a
(** Digest the given command. *)
val digest : t -> Digest.t
(** Maximum number of parallel jobs. *)
val jobs : int ref
(** Hook here the function that maps a set of tags to appropriate command
options. It also build the dependencies that matches the tags. *)
val tag_handler : (Tags.t -> spec) ref
(** For system use only *)
val dump_parallel_stats : unit -> unit
val deps_of_tags : Tags.t -> pathname list
(** [dep tags deps] Will build [deps] when [tags] will be activated. *)
val dep : Tags.elt list -> pathname list -> unit
val pdep : Tags.elt list -> Tags.elt -> (string -> pathname list) -> unit
val list_all_deps : unit -> (Tags.t * pathname list) list
val file_or_exe_exists: string -> bool

96
ocamlbuild/configuration.ml
View File

@ -1,96 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
open Log
open Lexers
type t = Lexers.conf
let acknowledge_config source config =
let ack (tag, loc) = Param_tags.acknowledge source (Some loc) tag in
List.iter (fun (_, config) -> List.iter ack config.plus_tags) config
let cache = Hashtbl.create 107
let (configs, add_config) =
let configs = ref [] in
(fun () -> !configs),
(fun source config ->
acknowledge_config source config;
configs := config :: !configs;
Hashtbl.clear cache)
let parse_lexbuf ?dir source lexbuf =
let conf = Lexers.conf_lines dir source lexbuf in
add_config source conf
let parse_string ?source s =
let source = match source with
| Some source -> source
| None -> Const.Source.configuration
in
parse_lexbuf source (lexbuf_of_string s)
let parse_file ?dir file =
with_input_file file begin fun ic ->
let lexbuf = Lexing.from_channel ic in
set_lexbuf_fname file lexbuf;
parse_lexbuf ?dir Const.Source.file lexbuf
end
let key_match = Glob.eval
let apply_config s (config : t) init =
let add (tag, _loc) = Tags.add tag in
let remove (tag, _loc) = Tags.remove tag in
List.fold_left begin fun tags (key, v) ->
if key_match key s then
List.fold_right add v.plus_tags (List.fold_right remove v.minus_tags tags)
else tags
end init config
let apply_configs s = List.fold_right (apply_config s) (configs ()) Tags.empty
let tags_of_filename s =
try Hashtbl.find cache s
with Not_found ->
let res = apply_configs s in
let () = Hashtbl.replace cache s res in
res
let global_tags () = tags_of_filename ""
let has_tag tag = Tags.mem tag (global_tags ())
let tag_file file tags =
if tags <> [] then parse_string (Printf.sprintf "%S: %s" file (String.concat ", " tags));;
let tag_any tags =
if tags <> [] then parse_string (Printf.sprintf "true: %s" (String.concat ", " tags));;
let check_tags_usage useful_tags =
let check_tag (tag, loc) =
if not (Tags.mem tag useful_tags) then
Log.eprintf "%aWarning: the tag %S is not used in any flag or dependency \
declaration, so it will have no effect; it may be a typo. \
Otherwise you can use `mark_tag_used` in your myocamlbuild.ml \
to disable this warning."
Loc.print_loc loc tag
in
let check_conf (_, values) =
List.iter check_tag values.plus_tags;
List.iter check_tag values.minus_tags;
in
List.iter (List.iter check_conf) (configs ())

45
ocamlbuild/configuration.mli
View File

@ -1,45 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(* Configuration *)
(** Handles the "_tags" file mechanism. *)
(** Incorporate a newline-separated configuration string into the current configuration.
Will usually raising an [Invalid_arg] with an appropriately explicit message in case of error. *)
val parse_string : ?source:Loc.source -> string -> unit
(** [parse_file ?dir fn] incorporates the configuration file named [fn], prefixing its glob patterns
with [dir] if given. *)
val parse_file : ?dir:string -> string -> unit
(** Return the set of tags that apply to a given filename under the current configuration. *)
val tags_of_filename : string -> Tags.t
val has_tag : string -> bool
(** [tag_file filename tag_list] Tag the given filename with all given tags. *)
val tag_file : Pathname.t -> Tags.elt list -> unit
(** [tag_any tag_list] Tag anything with all given tags. *)
val tag_any : Tags.elt list -> unit
(** the tags that apply to any file *)
val global_tags : unit -> Tags.t
(** Given the list of all tags that are really used by an existing
flagset, traverse existing configuration files and warns on tags
that will never get used. *)
val check_tags_usage : Tags.t -> unit

11
ocamlbuild/const.ml
View File

@ -1,11 +0,0 @@
module Source = struct
let file = "file"
let command_line = "command-line"
let path = "path"
let ocamlfind_query = "ocamlfind query"
let ocamldep = "ocamldep"
let target_pattern = "target pattern"
let builtin = "builtin configuration"
let configuration = "configuration"
let plugin_tag = "plugin tag"
end

43
ocamlbuild/digest_cache.ml
View File

@ -1,43 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
open Pathname.Operators
let digests = Hashtbl.create 103
let get = Hashtbl.find digests
let put = Hashtbl.replace digests
let _digests = lazy (!Options.build_dir / (Pathname.mk "_digests"))
let finalize () =
with_output_file !*_digests begin fun oc ->
Hashtbl.iter begin fun name digest ->
Printf.fprintf oc "%S: %S\n" name digest
end digests
end
let init () =
Shell.chdir !Options.build_dir;
if Pathname.exists !*_digests then
with_input_file !*_digests begin fun ic ->
try while true do
let l = input_line ic in
Scanf.sscanf l "%S: %S" put
done with End_of_file -> ()
end;
My_unix.at_exit_once finalize

19
ocamlbuild/digest_cache.mli
View File

@ -1,19 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val init : unit -> unit
val get : string -> string
val put : string -> string -> unit

17
ocamlbuild/discard_printf.ml
View File

@ -1,17 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
let discard_printf fmt = Format.ifprintf Format.std_formatter fmt;;

21
ocamlbuild/discard_printf.mli
View File

@ -1,21 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(* Discard_printf *)
(** This module compiled with [-rectypes] allows one to write functions
taking formatters as arguments. *)
open Format
val discard_printf: ('a, formatter, unit) format -> 'a

396
ocamlbuild/display.ml
View File

@ -1,396 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Display *)
open My_std;;
open My_unix;;
let fp = Printf.fprintf;;
(*** ANSI *)
module ANSI =
struct
let up oc n = fp oc "\027[%dA" n;;
let clear_to_eol oc () = fp oc "\027[K";;
let bol oc () = fp oc "\r";;
let get_columns () =
if Sys.os_type = "Unix" then
try
int_of_string (String.chomp (My_unix.run_and_read "tput cols"))
with
| Failure _ -> 80
else 80
end
;;
(* ***)
(*** tagline_description *)
type tagline_description = (string * char) list;;
(* ***)
(*** sophisticated_display *)
type sophisticated_display = {
ds_channel : out_channel; (** Channel for writing *)
ds_start_time : float; (** When was compilation started *)
mutable ds_last_update : float; (** When was the display last updated *)
mutable ds_last_target : string; (** Last target built *)
mutable ds_last_cached : bool; (** Was the last target cached or really built ? *)
mutable ds_last_tags : Tags.t; (** Tags of the last command *)
mutable ds_changed : bool; (** Does the tag line need recomputing ? *)
ds_update_interval : float; (** Minimum interval between updates *)
ds_columns : int; (** Number of columns in dssplay *)
mutable ds_jobs : int; (** Number of jobs launched or cached *)
mutable ds_jobs_cached : int; (** Number of jobs cached *)
ds_tagline : bytes; (** Current tagline *)
mutable ds_seen_tags : Tags.t; (** Tags that we have encountered *)
ds_pathname_length : int; (** How much space for displaying pathnames ? *)
ds_tld : tagline_description; (** Description for the tagline *)
};;
(* ***)
(*** display_line, display *)
type display_line =
| Classic
| Sophisticated of sophisticated_display
type display = {
di_log_level : int;
mutable di_log_channel : (Format.formatter * out_channel) option;
di_channel : out_channel;
di_formatter : Format.formatter;
di_display_line : display_line;
mutable di_finished : bool;
}
;;
(* ***)
(*** various defaults *)
let default_update_interval = 0.05;;
let default_tagline_description = [
"ocaml", 'O';
"native", 'N';
"byte", 'B';
"program", 'P';
"pp", 'R';
"debug", 'D';
"interf", 'I';
"link", 'L';
];;
(* NOT including spaces *)
let countdown_chars = 8;;
let jobs_chars = 3;;
let jobs_cached_chars = 5;;
let dots = "...";;
let start_target = "STARTING";;
let finish_target = "FINISHED";;
let ticker_chars = 3;;
let ticker_period = 0.25;;
let ticker_animation = [|
"\\";
"|";
"/";
"-";
|];;
let cached = "*";;
let uncached = " ";;
let cache_chars = 1;;
(* ***)
(*** create_tagline *)
let create_tagline description = Bytes.make (List.length description) '-';;
(* ***)
(*** create *)
let create
?(channel=stdout)
?(mode:[`Classic|`Sophisticated] = `Sophisticated)
?columns:(_columns=75)
?(description = default_tagline_description)
?log_file
?(log_level=1)
()
=
let log_channel =
match log_file with
| None -> None
| Some fn ->
let oc = open_out_gen [Open_text; Open_wronly; Open_creat; Open_trunc] 0o666 fn in
let f = Format.formatter_of_out_channel oc in
Format.fprintf f "### Starting build.\n";
Some (f, oc)
in
let display_line =
match mode with
| `Classic -> Classic
| `Sophisticated ->
(* We assume Unix is not degraded. *)
let n = ANSI.get_columns () in
let tag_chars = List.length description in
Sophisticated
{ ds_channel = stdout;
ds_start_time = gettimeofday ();
ds_last_update = 0.0;
ds_last_target = start_target;
ds_last_tags = Tags.empty;
ds_last_cached = false;
ds_changed = false;
ds_update_interval = default_update_interval;
ds_columns = n;
ds_jobs = 0;
ds_jobs_cached = 0;
ds_tagline = create_tagline description;
ds_seen_tags = Tags.empty;
ds_pathname_length = n -
(countdown_chars + 1 + jobs_chars + 1 + jobs_cached_chars + 1 +
cache_chars + 1 + tag_chars + 1 + ticker_chars + 2);
ds_tld = description }
in
{ di_log_level = log_level;
di_log_channel = log_channel;
di_channel = channel;
di_formatter = Format.formatter_of_out_channel channel;
di_display_line = display_line;
di_finished = false }
;;
(* ***)
(*** print_time *)
let print_time oc t =
let t = int_of_float t in
let s = t mod 60 in
let m = (t / 60) mod 60 in
let h = t / 3600 in
fp oc "%02d:%02d:%02d" h m s
;;
(* ***)
(*** print_shortened_pathname *)
let print_shortened_pathname length oc u =
assert(length >= 3);
let m = String.length u in
if m <= length then
begin
output_string oc u;
fp oc "%*s" (length - m) ""
end
else
begin
let n = String.length dots in
let k = length - n in
output_string oc dots;
output_substring oc u (m - k) k;
end
(* ***)
(*** Layout
00000000001111111111222222222233333333334444444444555555555566666666667777777777
01234567890123456789012345678901234567890123456789012345678901234567890123456789
HH MM SS XXXX PATHNAME
00:12:31 32 ( 26) ...lp4Filters/Camlp4LocationStripper.cmo * OBn-------------
| | | | | \ tags
| | | \ last target built \ cached ?
| | |
| | \ number of jobs cached
| \ number of jobs
\ elapsed time
cmo mllib
***)
(*** redraw_sophisticated *)
let redraw_sophisticated ds =
let t = gettimeofday () in
let oc = ds.ds_channel in
let dt = t -. ds.ds_start_time in
ds.ds_last_update <- t;
fp oc "%a" ANSI.bol ();
let ticker_phase = (abs (int_of_float (ceil (dt /. ticker_period)))) mod (Array.length ticker_animation) in
let ticker = ticker_animation.(ticker_phase) in
fp oc "%a %-4d (%-4d) %a %s %s %s"
print_time dt
ds.ds_jobs
ds.ds_jobs_cached
(print_shortened_pathname ds.ds_pathname_length) ds.ds_last_target
(if ds.ds_last_cached then cached else uncached)
(Bytes.to_string ds.ds_tagline)
ticker;
fp oc "%a%!" ANSI.clear_to_eol ()
;;
(* ***)
(*** redraw *)
let redraw = function
| Classic -> ()
| Sophisticated ds -> redraw_sophisticated ds
;;
(* ***)
(*** finish_sophisticated *)
let finish_sophisticated ?(how=`Success) ds =
let t = gettimeofday () in
let oc = ds.ds_channel in
let dt = t -. ds.ds_start_time in
match how with
| `Success|`Error ->
fp oc "%a" ANSI.bol ();
fp oc "%s %d target%s (%d cached) in %a."
(if how = `Error then
"Compilation unsuccessful after building"
else
"Finished,")
ds.ds_jobs
(if ds.ds_jobs = 1 then "" else "s")
ds.ds_jobs_cached
print_time dt;
fp oc "%a\n%!" ANSI.clear_to_eol ()
| `Quiet ->
fp oc "%a%a%!" ANSI.bol () ANSI.clear_to_eol ();
;;
(* ***)
(*** sophisticated_display *)
let sophisticated_display ds f =
fp ds.ds_channel "%a%a%!" ANSI.bol () ANSI.clear_to_eol ();
f ds.ds_channel
;;
(* ***)
(*** call_if *)
let call_if log_channel f =
match log_channel with
| None -> ()
| Some x -> f x
;;
(* ***)
(*** display *)
let display di f =
call_if di.di_log_channel (fun (_, oc) -> f oc);
match di.di_display_line with
| Classic -> f di.di_channel
| Sophisticated ds -> sophisticated_display ds f
;;
(* ***)
(*** finish *)
let finish ?(how=`Success) di =
if not di.di_finished then begin
di.di_finished <- true;
call_if di.di_log_channel
begin fun (fmt, oc) ->
Format.fprintf fmt "# Compilation %ssuccessful.@." (if how = `Error then "un" else "");
close_out oc;
di.di_log_channel <- None
end;
match di.di_display_line with
| Classic -> ()
| Sophisticated ds -> finish_sophisticated ~how ds
end
;;
(* ***)
(*** update_tagline_from_tags *)
let update_tagline_from_tags ds =
let tagline = ds.ds_tagline in
let tags = ds.ds_last_tags in
let rec loop i = function
| [] ->
for j = i to Bytes.length tagline - 1 do
Bytes.set tagline j '-'
done
| (tag, c) :: rest ->
if Tags.mem tag tags then
Bytes.set tagline i (Char.uppercase_ascii c)
else
if Tags.mem tag ds.ds_seen_tags then
Bytes.set tagline i (Char.lowercase_ascii c)
else
Bytes.set tagline i '-';
loop (i + 1) rest
in
loop 0 ds.ds_tld;
;;
(* ***)
(*** update_sophisticated *)
let update_sophisticated ds =
let t = gettimeofday () in
let dt = t -. ds.ds_last_update in
if dt > ds.ds_update_interval then
begin
if ds.ds_changed then
begin
update_tagline_from_tags ds;
ds.ds_changed <- false
end;
redraw_sophisticated ds
end
else
()
;;
(* ***)
(*** set_target_sophisticated *)
let set_target_sophisticated ds target tags cached =
ds.ds_changed <- true;
ds.ds_last_target <- target;
ds.ds_last_tags <- tags;
ds.ds_jobs <- 1 + ds.ds_jobs;
if cached then ds.ds_jobs_cached <- 1 + ds.ds_jobs_cached;
ds.ds_last_cached <- cached;
ds.ds_seen_tags <- Tags.union ds.ds_seen_tags ds.ds_last_tags;
update_sophisticated ds
;;
let print_tags f tags =
let first = ref true in
Tags.iter begin fun tag ->
if !first then begin
first := false;
Format.fprintf f "%s" tag
end else Format.fprintf f ", %s" tag
end tags
;;
(* ***)
(*** update *)
let update di =
match di.di_display_line with
| Classic -> ()
| Sophisticated ds -> update_sophisticated ds
;;
(* ***)
(*** event *)
let event di ?(pretend=false) command target tags =
call_if di.di_log_channel
(fun (fmt, _) ->
Format.fprintf fmt "# Target: %s, tags: { %a }\n" target print_tags tags;
Format.fprintf fmt "%s%s@." command (if pretend then " # cached" else ""));
match di.di_display_line with
| Classic ->
if pretend then
begin
(* This should work, even on Windows *)
let command = Filename.basename command in
if di.di_log_level >= 2 then Format.fprintf di.di_formatter "[cache hit] %s\n%!" command
end
else
(if di.di_log_level >= 1 then Format.fprintf di.di_formatter "%s\n%!" command)
| Sophisticated ds ->
set_target_sophisticated ds target tags pretend;
update_sophisticated ds
;;
(* ***)
(*** dprintf *)
let is_logging di log_level = log_level <= di.di_log_level
let dprintf ?(raw=false) ?(log_level=1) di fmt =
if log_level > di.di_log_level then Discard_printf.discard_printf fmt else
let fmt = if raw then fmt else "@[<2>"^^fmt^^"@]@." in
match di.di_display_line with
| Classic -> Format.fprintf di.di_formatter fmt
| Sophisticated _ ->
if log_level < 0 then
begin
display di ignore;
Format.fprintf di.di_formatter fmt
end
else
match di.di_log_channel with
| Some (f, _) -> Format.fprintf f fmt
| None -> Discard_printf.discard_printf fmt
(* ***)

36
ocamlbuild/display.mli
View File

@ -1,36 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Display *)
type display
type tagline_description = (string * char) list
val create :
?channel:out_channel ->
?mode:[ `Classic | `Sophisticated ] ->
?columns:int ->
?description:tagline_description ->
?log_file:string ->
?log_level:int ->
unit ->
display
val finish : ?how:[`Success|`Error|`Quiet] -> display -> unit
val event : display -> ?pretend:bool -> string -> string -> Tags.t -> unit
val display : display -> (out_channel -> unit) -> unit
val update : display -> unit
val is_logging : display -> int -> bool
val dprintf : ?raw:bool -> ?log_level:int -> display -> ('a, Format.formatter, unit) format -> 'a

18
ocamlbuild/examples/example1/hello.ml
View File

@ -1,18 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
let _ =
Printf.printf "Hello, %s ! My name is %s\n"
(if Array.length Sys.argv > 1 then Sys.argv.(1) else "stranger")
Sys.argv.(0)
;;

19
ocamlbuild/examples/example2/greet.ml
View File

@ -1,19 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
type how = Nicely | Badly;;
let greet how who =
match how with Nicely -> Printf.printf "Hello, %s !\n" who
| Badly -> Printf.printf "Oh, here is that %s again.\n" who
;;

27
ocamlbuild/examples/example2/hello.ml
View File

@ -1,27 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
open Greet
let _ =
let name =
if Array.length Sys.argv > 1 then
Sys.argv.(1)
else
"stranger"
in
greet
(if name = "Caesar" then Nicely else Badly)
name;
Printf.printf "My name is %s\n" Sys.argv.(0)
;;

19
ocamlbuild/examples/example3/epoch.ml
View File

@ -1,19 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
let _ =
let s = Num.num_of_string (Printf.sprintf "%.0f" (Unix.gettimeofday ())) in
let ps = Num.mult_num (Num.num_of_string "1000000000000") s in
Printf.printf "%s picoseconds have passed since January 1st, 1970.\n"
(Num.string_of_num ps)
;;

44
ocamlbuild/examples/example3/make.sh
View File

@ -1,44 +0,0 @@
#!/bin/sh
#########################################################################
# #
# OCaml #
# #
# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt #
# #
# Copyright 2007 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the Q Public License version 1.0. #
# #
#########################################################################
set -e
TARGET=epoch
FLAGS="-libs unix,nums"
OCAMLBUILD=ocamlbuild
ocb()
{
$OCAMLBUILD $FLAGS $*
}
rule() {
case $1 in
clean) ocb -clean;;
native) ocb $TARGET.native;;
byte) ocb $TARGET.byte;;
all) ocb $TARGET.native $TARGET.byte;;
depend) echo "Not needed.";;
*) echo "Unknown action $1";;
esac;
}
if [ $# -eq 0 ]; then
rule all
else
while [ $# -gt 0 ]; do
rule $1;
shift
done
fi

28
ocamlbuild/exit_codes.ml
View File

@ -1,28 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
let rc_ok = 0
let rc_usage = 1
let rc_failure = 2
let rc_invalid_argument = 3
let rc_system_error = 4
let rc_hygiene = 1
let rc_circularity = 5
let rc_solver_failed = 6
let rc_ocamldep_error = 7
let rc_lexing_error = 8
let rc_build_error = 9
let rc_executor_subcommand_failed = 10
let rc_executor_subcommand_got_signal = 11
let rc_executor_io_error = 12
let rc_executor_excetptional_condition = 13

28
ocamlbuild/exit_codes.mli
View File

@ -1,28 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
val rc_ok : int
val rc_usage : int
val rc_failure : int
val rc_invalid_argument : int
val rc_system_error : int
val rc_hygiene : int
val rc_circularity : int
val rc_solver_failed : int
val rc_ocamldep_error : int
val rc_lexing_error : int
val rc_build_error : int
val rc_executor_subcommand_failed : int
val rc_executor_subcommand_got_signal : int
val rc_executor_io_error : int
val rc_executor_excetptional_condition : int

83
ocamlbuild/fda.ml
View File

@ -1,83 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* FDA *)
open Log
open Hygiene
;;
exception Exit_hygiene_failed
;;
let laws =
[
{ law_name = "Leftover OCaml compilation files";
law_rules = [Not ".cmo"; Not ".cmi"; Not ".cmx"; Not ".cma"; Not ".cmxa"];
law_penalty = Fail };
{ law_name = "Leftover OCaml type annotation files";
law_rules = [Not ".annot"];
law_penalty = Warn };
{ law_name = "Leftover object files";
law_rules = [Not ".o"; Not ".a"; Not ".so"; Not ".obj"; Not ".lib"; Not ".dll"];
law_penalty = Fail };
{ law_name = "Leftover ocamlyacc-generated files";
law_rules = [Implies_not(".mly",".ml"); Implies_not(".mly",".mli")];
law_penalty = Fail };
{ law_name = "Leftover ocamllex-generated files";
law_rules = [Implies_not(".mll",".ml")];
law_penalty = Fail };
{ law_name = "Leftover dependency files";
law_rules = [Not ".ml.depends"; Not ".mli.depends"];
law_penalty = Fail }
]
let inspect entry =
dprintf 5 "Doing sanity checks";
let evil = ref false in
match Hygiene.check
?sanitize:
begin
if !Options.sanitize then
Some(Pathname.concat !Options.build_dir !Options.sanitization_script)
else
None
end
laws entry
with
| [] -> ()
| stuff ->
List.iter
begin fun (law, msgs) ->
Printf.printf "%s: %s:\n"
(match law.law_penalty with
| Warn -> "Warning"
| Fail ->
if not !evil then
begin
Printf.printf "IMPORTANT: I cannot work with leftover compiled files.\n%!";
evil := true
end;
"ERROR")
law.law_name;
List.iter
begin fun msg ->
Printf.printf " %s\n" msg
end
msgs
end
stuff;
if !evil then raise Exit_hygiene_failed;
;;

20
ocamlbuild/fda.mli
View File

@ -1,20 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Fda *)
exception Exit_hygiene_failed
val inspect : bool Slurp.entry -> unit

199
ocamlbuild/findlib.ml
View File

@ -1,199 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Romain Bardou *)
open My_std
open My_unix
open Command
type command_spec = Command.spec
type error =
| Cannot_run_ocamlfind
| Dependency_not_found of string * string (* package, dependency *)
| Package_not_found of string
| Cannot_parse_query of string * string (* package, explaination *)
exception Findlib_error of error
let error x = raise (Findlib_error x)
let string_of_error = function
| Cannot_run_ocamlfind ->
"Cannot run Ocamlfind."
| Dependency_not_found(p, d) ->
Printf.sprintf
"Ocamlfind returned \"%s\" as a dependency for package \"%s\" but does \
not know this dependency." d p
| Package_not_found p ->
Printf.sprintf "Findlib package not found: \"%s\"." p
| Cannot_parse_query(p, e) ->
Printf.sprintf "Cannot parse Ocamlfind query for package \"%s\": %s" p e
let report_error e =
prerr_endline (string_of_error e);
exit 2
let ocamlfind = "ocamlfind"
type package = {
name: string;
description: string;
version: string;
archives_byte: string;
archives_native: string;
link_options: string;
location: string;
dependencies: package list;
}
let packages = Hashtbl.create 42
let run_and_parse lexer command =
Printf.ksprintf
(fun command -> lexer & Lexing.from_string & run_and_read command)
command
let run_and_read command =
Printf.ksprintf run_and_read command
let rec query name =
try
Hashtbl.find packages name
with Not_found ->
try
let n, d, v, a_byte, lo, l =
run_and_parse
(Lexers.ocamlfind_query Const.Source.ocamlfind_query)
"%s query -l -predicates byte %s" ocamlfind name
in
let a_native =
run_and_parse
(Lexers.trim_blanks Const.Source.ocamlfind_query)
"%s query -a-format -predicates native %s" ocamlfind name
in
let deps =
run_and_parse
(Lexers.blank_sep_strings Const.Source.ocamlfind_query)
"%s query -r -p-format %s" ocamlfind name
in
let deps = List.filter ((<>) n) deps in
let deps =
try
List.map query deps
with Findlib_error (Package_not_found dep_name) ->
(* Ocamlfind cannot find a package which it returned as a dependency.
This should not happen. *)
error (Dependency_not_found (name, dep_name))
in
let package = {
name = n;
description = d;
version = v;
archives_byte = a_byte;
archives_native = a_native;
link_options = lo;
location = l;
dependencies = deps;
} in
Hashtbl.add packages n package;
package
with
| Failure _ ->
(* TODO: Improve to differenciate whether ocamlfind cannot be
run or is not installed *)
error Cannot_run_ocamlfind
| Lexers.Error (s,_) ->
error (Cannot_parse_query (name, s))
let split_nl s =
let x = ref [] in
let rec go s =
let pos = String.index s '\n' in
x := (String.before s pos)::!x;
go (String.after s (pos + 1))
in
try
go s
with Not_found -> !x
let before_space s =
try
String.before s (String.index s ' ')
with Not_found -> s
let list () =
List.map before_space (split_nl & run_and_read "%s list" ocamlfind)
(* The closure algorithm is easy because the dependencies are already closed
and sorted for each package. We only have to make the union. We could also
make another ocamlfind query such as:
ocamlfind query -p-format -r package1 package2 ... *)
let topological_closure l =
let add l x = if List.mem x l then l else x :: l in
let l = List.fold_left begin fun acc p ->
add (List.fold_left add acc p.dependencies) p
end [] l in
List.rev l
module SSet = Set.Make(String)
let add_atom a l = match a, l with
| A "", _ -> l
| _ -> a :: l
let include_flags l =
let pkgs = topological_closure l in
let locations = List.fold_left begin fun acc p ->
SSet.add p.location acc
end SSet.empty pkgs in
let flags = [] in
(* includes *)
let flags =
List.fold_left begin fun acc l ->
add_atom (P l) (add_atom (A "-I") acc)
end flags (SSet.elements locations)
in
S (List.rev flags)
let compile_flags_byte = include_flags
let compile_flags_native = include_flags
let link_flags f l =
let pkgs = topological_closure l in
let locations = List.fold_left begin fun acc p ->
SSet.add p.location acc
end SSet.empty pkgs in
let flags = [] in
(* includes *)
let flags =
List.fold_left begin fun acc l ->
add_atom (P l) (add_atom (A "-I") acc)
end flags (SSet.elements locations)
in
(* special link options *)
let flags =
List.fold_left begin fun acc x ->
add_atom (A x.link_options) acc
end flags pkgs
in
(* archives *)
let flags =
List.fold_left begin fun acc x ->
add_atom (A (f x)) acc
end flags pkgs
in
S (List.rev flags)
let link_flags_byte = link_flags (fun x -> x.archives_byte)
let link_flags_native = link_flags (fun x -> x.archives_native)

17
ocamlbuild/findlib.mli
View File

@ -1,17 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Romain Bardou *)
include Signatures.FINDLIB with type command_spec = Command.spec

79
ocamlbuild/flags.ml
View File

@ -1,79 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open Command
open Bool (* FIXME remove me *)
open Tags.Operators
type decl = {
tags: Tags.t;
flags: Command.spec;
deprecated: bool;
}
let flags_of_decl { flags; _ } = flags
let tags_of_decl { tags; _ } = tags
let all_decls = ref []
let of_tags matched_tags =
S begin
List.fold_left begin fun acc { tags; flags; _ } ->
if Tags.does_match matched_tags tags then flags :: acc
else acc
end [] !all_decls
end
let () = Command.tag_handler := of_tags
let of_tag_list x = of_tags (Tags.of_list x)
let add_decl decl =
all_decls := decl :: !all_decls
let flag ?(deprecated=false) tags flags =
let tags = Tags.of_list tags in
add_decl { tags; flags; deprecated }
let pflag tags ptag flags =
Param_tags.declare ptag
(fun param -> flag (Param_tags.make ptag param :: tags) (flags param))
let add x xs = x :: xs
let remove me = List.filter (fun x -> me <> x)
let pretty_print { tags; flags; deprecated } =
let sflag = Command.string_of_command_spec flags in
let header = if deprecated then "deprecated flag" else "flag" in
let pp fmt = Log.raw_dprintf (-1) fmt in
pp "@[<2>%s@ {. %a .}@ %S@]@\n@\n" header Tags.print tags sflag
let show_documentation () =
List.iter
(fun decl -> if not decl.deprecated then pretty_print decl)
!all_decls;
List.iter
(fun decl -> if decl.deprecated then pretty_print decl)
!all_decls;
let pp fmt = Log.raw_dprintf (-1) fmt in
pp "@."
let used_tags = ref Tags.empty
let mark_tag_used tag =
used_tags := Tags.add tag !used_tags
let get_used_tags () =
List.fold_left (fun acc decl -> Tags.union acc decl.tags)
!used_tags !all_decls

41
ocamlbuild/flags.mli
View File

@ -1,41 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val of_tags : Tags.t -> Command.spec
val of_tag_list : Tags.elt list -> Command.spec
(* The ?deprecated parameter marks the flag declaration as deprecated,
because it is superseded by a different, better way to express the
same thing (eg. a parametrized tag). So far, it is only used when
showing documentation.
This flag is not exported in OCamlbuild_plugin interface for now. It
would make sense to let plugin authors deprecate their own flags,
but it has to be balanced again the simplicity of the plugin
interface exposed. If you're reading this as a plugin author that
has a real need for deprecation, drop us a note on the bugtracker. *)
val flag : ?deprecated:bool -> Tags.elt list -> Command.spec -> unit
val pflag : Tags.elt list -> string -> (string -> Command.spec) -> unit
val add : 'a -> 'a list -> 'a list
val remove : 'a -> 'a list -> 'a list
val show_documentation : unit -> unit
(** "useful" tags: they are used by a tag declaration, or have been
explicitly added with [mark_as_used] *)
val get_used_tags : unit -> Tags.t
val mark_tag_used : Tags.elt -> unit

414
ocamlbuild/glob.ml
View File

@ -1,414 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Glob *)
open My_std;;
open Bool;;
include Glob_ast;;
open Glob_lexer;;
let sf = Printf.sprintf;;
let brute_limit = 10;;
(*** string_of_token *)
let string_of_token = function
| ATOM _ -> "ATOM"
| AND -> "AND"
| OR -> "OR"
| NOT -> "NOT"
| LPAR -> "LPAR"
| RPAR -> "RPAR"
| TRUE -> "TRUE"
| FALSE -> "FALSE"
| EOF -> "EOF"
;;
(* ***)
(*** match_character_class *)
let match_character_class cl c =
Bool.eval
begin function (c1,c2) ->
c1 <= c && c <= c2
end
cl
;;
(* ***)
(*** NFA *)
module NFA =
struct
type transition =
| QCLASS of character_class
| QEPSILON
;;
module IS = Set.Make(struct type t = int let compare (x:t) y = compare x y let print = Format.pp_print_int end);;
module ISM = Map.Make(struct type t = IS.t let compare = IS.compare let print = IS.print end);;
type machine = {
mc_qi : IS.t;
mc_table : (character_class * IS.t) list array;
mc_qf : int;
mc_power_table : (char, IS.t ISM.t) Hashtbl.t
}
(*** build' *)
let build' p =
let count = ref 0 in
let transitions = ref [] in
let epsilons : (int * int) list ref = ref [] in
let state () = let id = !count in incr count; id in
let ( --> ) q1 t q2 =
match t with
| QEPSILON -> epsilons := (q1,q2) :: !epsilons; q1
| QCLASS cl -> transitions := (q1,cl,q2) :: !transitions; q1
in
(* Build the transitions corresponding to the given pattern and arriving
* on state qf. Return the original state. *)
let rec loop qf = function
| Epsilon -> qf
| Word u ->
let m = String.length u in
let q0 = state () in
let rec loop q i =
if i = m then
q0
else
begin
let q' =
if i = m - 1 then
qf
else
state ()
in
let _ = (q --> QCLASS(Atom(u.[i], u.[i]))) q' in
loop q' (i + 1)
end
in
loop q0 0
| Class cl ->
let q1 = state () in
(q1 --> QCLASS cl) qf
| Star p ->
(* The fucking Kleene star *)
let q2 = state () in
let q1 = loop q2 p in (* q1 -{p}-> q2 *)
let _ = (q1 --> QEPSILON) qf in
let _ = (q2 --> QEPSILON) q1 in
let _ = (q2 --> QEPSILON) q1 in
q1
| Concat(p1,p2) ->
let q12 = state () in
let q1 = loop q12 p1 in (* q1 -{p1}-> q12 *)
let q2 = loop qf p2 in (* q2 -{p2}-> qf *)
let _ = (q12 --> QEPSILON) q2 in
q1
| Union pl ->
let qi = state () in
List.iter
begin fun p ->
let q = loop qf p in (* q -{p2}-> qf *)
let _ = (qi --> QEPSILON) q in (* qi -{}---> q *)
()
end
pl;
qi
in
let qf = state () in
let qi = loop qf p in
let m = !count in
(* Compute epsilon closure *)
let graph = Array.make m IS.empty in
List.iter
begin fun (q,q') ->
graph.(q) <- IS.add q' graph.(q)
end
!epsilons;
let closure = Array.make m IS.empty in
let rec transitive past = function
| [] -> past
| q :: future ->
let past' = IS.add q past in
let future' =
IS.fold
begin fun q' future' ->
(* q -{}--> q' *)
if IS.mem q' past' then
future'
else
q' :: future'
end
graph.(q)
future
in
transitive past' future'
in
for i = 0 to m - 1 do
closure.(i) <- transitive IS.empty [i] (* O(n^2), I know *)
done;
(* Finally, build the table *)
let table = Array.make m [] in
List.iter
begin fun (q,t,q') ->
table.(q) <- (t, closure.(q')) :: table.(q)
end
!transitions;
(graph, closure,
{ mc_qi = closure.(qi);
mc_table = table;
mc_qf = qf;
mc_power_table = Hashtbl.create 37 })
;;
let build x = let (_,_, machine) = build' x in machine;;
(* ***)
(*** run *)
let run ?(trace=false) machine u =
let m = String.length u in
let apply qs c =
try
let t = Hashtbl.find machine.mc_power_table c in
ISM.find qs t
with
| Not_found ->
let qs' =
IS.fold
begin fun q qs' ->
List.fold_left
begin fun qs' (cl,qs'') ->
if match_character_class cl c then
IS.union qs' qs''
else
qs'
end
qs'
machine.mc_table.(q)
end
qs
IS.empty
in
let t =
try
Hashtbl.find machine.mc_power_table c
with
| Not_found -> ISM.empty
in
Hashtbl.replace machine.mc_power_table c (ISM.add qs qs' t);
qs'
in
let rec loop qs i =
if IS.is_empty qs then
false
else
begin
if i = m then
IS.mem machine.mc_qf qs
else
begin
let c = u.[i] in
if trace then
begin
Printf.printf "%d %C {" i c;
IS.iter (fun q -> Printf.printf " %d" q) qs;
Printf.printf " }\n%!"
end;
let qs' = apply qs c in
loop qs' (i + 1)
end
end
in
loop machine.mc_qi 0
;;
(* ***)
end
;;
(* ***)
(*** Brute *)
module Brute =
struct
exception Succeed;;
exception Fail;;
exception Too_hard;;
(*** match_pattern *)
let match_pattern counter p u =
let m = String.length u in
(** [loop i n p] returns [true] iff the word [u.(i .. i + n - 1)] is in the
** language generated by the pattern [p].
** We must have 0 <= i and i + n <= m *)
let rec loop (i,n,p) =
assert (0 <= i && 0 <= n && i + n <= m);
incr counter;
if !counter >= brute_limit then raise Too_hard;
match p with
| Word v ->
String.length v = n &&
begin
let rec check j = j = n || (v.[j] = u.[i + j] && check (j + 1))
in
check 0
end
| Epsilon -> n = 0
| Star(Class True) -> true
| Star(Class cl) ->
let rec check k =
if k = n then
true
else
(match_character_class cl u.[i + k]) && check (k + 1)
in
check 0
| Star _ -> raise Too_hard
| Class cl -> n = 1 && match_character_class cl u.[i]
| Concat(p1,p2) ->
let rec scan j =
j <= n && ((loop (i,j,p1) && loop (i+j, n - j,p2)) || scan (j + 1))
in
scan 0
| Union pl -> List.exists (fun p' -> loop (i,n,p')) pl
in
loop (0,m,p)
;;
(* ***)
end
;;
(* ***)
(*** fast_pattern_contents, fast_pattern, globber *)
type fast_pattern_contents =
| Brute of int ref * pattern
| Machine of NFA.machine
;;
type fast_pattern = fast_pattern_contents ref;;
type globber = fast_pattern atom Bool.boolean;;
(* ***)
(*** fast_pattern_of_pattern *)
let fast_pattern_of_pattern p = ref (Brute(ref 0, p));;
(* ***)
(*** add_dir *)
let add_dir dir x =
match dir with
| None -> x
| Some(dir) ->
match x with
| Constant(s) ->
Constant(My_std.filename_concat dir s)
| Pattern(p) ->
Pattern(Concat(Word(My_std.filename_concat dir ""), p))
;;
(* ***)
(*** add_ast_dir *)
let add_ast_dir dir x =
match dir with
| None -> x
| Some dir ->
let slash = Class(Atom('/','/')) in
let any = Class True in
let q = Union[Epsilon; Concat(slash, Star any)] in (* ( /** )? *)
And[Atom(Pattern(ref (Brute(ref 0, Concat(Word dir, q))))); x]
;;
(* ***)
(*** parse *)
let parse ?dir u =
let l = Lexing.from_string u in
let tok = ref None in
let f =
fun () ->
match !tok with
| None -> token l
| Some x ->
tok := None;
x
in
let g t =
match !tok with
| None -> tok := Some t
| Some t' ->
raise (Parse_error(sf "Trying to unput token %s while %s is active" (string_of_token t) (string_of_token t')))
in
let read x =
let y = f () in
if x = y then
()
else
raise (Parse_error(sf "Unexpected token, expecting %s, got %s" (string_of_token x) (string_of_token y)))
in
let rec atomizer continuation = match f () with
| NOT -> atomizer (fun x -> continuation (Not x))
| ATOM x ->
begin
let a =
match add_dir dir x with
| Constant u -> Constant u
| Pattern p -> Pattern(fast_pattern_of_pattern p)
in
continuation (Atom a)
end
| TRUE -> continuation True
| FALSE -> continuation False
| LPAR ->
let y = parse_s () in
read RPAR;
continuation y
| t -> raise (Parse_error(sf "Unexpected token %s in atomizer" (string_of_token t)))
and parse_s1 x = match f () with
| OR -> let y = parse_s () in Or[x; y]
| AND -> parse_t x
| t -> g t; x
and parse_t1 x y = match f () with
| OR -> let z = parse_s () in Or[And[x;y]; z]
| AND -> parse_t (And[x;y])
| t -> g t; And[x;y]
and parse_s () = atomizer parse_s1
and parse_t x = atomizer (parse_t1 x)
in
let x = parse_s () in
read EOF;
add_ast_dir dir x
;;
(* ***)
(*** eval *)
let eval g u =
Bool.eval
begin function
| Constant v -> u = v
| Pattern kind ->
match !kind with
| Brute(count, p) ->
begin
let do_nfa () =
let m = NFA.build p in
kind := Machine m;
NFA.run m u
in
if !count >= brute_limit then
do_nfa ()
else
try
Brute.match_pattern count p u
with
| Brute.Too_hard -> do_nfa ()
end
| Machine m -> NFA.run m u
end
g
(* ***)
(*** Debug *)
(*let (Atom(Pattern x)) = parse "<{a,b}>";;
#install_printer IS.print;;
#install_printer ISM.print;;
let (graph, closure, machine) = build' x;;*)
(* ***)

25
ocamlbuild/glob.mli
View File

@ -1,25 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Glob *)
(** The type representing fast patterns. Do not attempt to compare them, as they get on-the-fly optimizations. *)
type fast_pattern
(** A self-contained module implementing extended shell glob patterns who have an expressive power
equal to boolean combinations of regular expressions. *)
include Signatures.GLOB with type globber = fast_pattern Glob_ast.atom Bool.boolean
val fast_pattern_of_pattern : Glob_ast.pattern -> fast_pattern

33
ocamlbuild/glob_ast.ml
View File

@ -1,33 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Glob_ast *)
exception Parse_error of string;;
type pattern =
| Epsilon
| Star of pattern (* The fucking Kleene star *)
| Class of character_class
| Concat of pattern * pattern
| Union of pattern list
| Word of string
and character_class = (char * char) Bool.boolean
;;
type 'pattern atom =
| Constant of string
| Pattern of 'pattern
;;

27
ocamlbuild/glob_ast.mli
View File

@ -1,27 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Glob_ast *)
exception Parse_error of string
type pattern =
| Epsilon
| Star of pattern
| Class of character_class
| Concat of pattern * pattern
| Union of pattern list
| Word of string
and character_class = (char * char) Bool.boolean
type 'pattern atom = Constant of string | Pattern of 'pattern

29
ocamlbuild/glob_lexer.mli
View File

@ -1,29 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
open Glob_ast
type token =
| ATOM of pattern atom
| AND
| OR
| NOT
| LPAR
| RPAR
| TRUE
| FALSE
| EOF
val token : Lexing.lexbuf -> token

118
ocamlbuild/glob_lexer.mll
View File

@ -1,118 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Glob *)
{
open Bool;;
open Glob_ast;;
type token =
| ATOM of pattern atom
| AND
| OR
| NOT
| LPAR
| RPAR
| TRUE
| FALSE
| EOF
;;
let sf = Printf.sprintf;;
let concat_patterns p1 p2 =
match (p1,p2) with
| (Epsilon,_) -> p2
| (_,Epsilon) -> p1
| (_,_) -> Concat(p1,p2)
;;
let slash = Class(Atom('/','/'));;
let not_slash = Class(Not(Atom('/','/')));;
let any = Class True;;
}
let pattern_chars = ['a'-'z']|['A'-'Z']|'_'|'-'|['0'-'9']|'.'
let space_chars = [' ' '\t' '\n' '\r' '\012']
rule token = parse
| '<' { ATOM(Pattern(let (p,_) = parse_pattern ['>'] Epsilon lexbuf in p)) }
| '"' { ATOM(Constant(parse_string (Buffer.create 32) lexbuf)) }
| "and"|"AND"|"&" { AND }
| "or"|"OR"|"|" { OR }
| "not"|"NOT"|"~" { NOT }
| "true"|"1" { TRUE }
| "false"|"0" { FALSE }
| "(" { LPAR }
| ")" { RPAR }
| space_chars+ { token lexbuf }
| eof { EOF }
and parse_pattern eof_chars p = parse
| (pattern_chars+ as u) { parse_pattern eof_chars (concat_patterns p (Word u)) lexbuf }
| '{'
{
let rec loop pl =
let (p',c) = parse_pattern ['}';','] Epsilon lexbuf in
let pl = p' :: pl in
if c = ',' then
loop pl
else
parse_pattern eof_chars (concat_patterns p (Union pl)) lexbuf
in
loop []
}
| "[^"
{
let cl = Not(Or(parse_class [] lexbuf)) in
parse_pattern eof_chars (concat_patterns p (Class cl)) lexbuf
}
| '['
{
let cl = Or(parse_class [] lexbuf) in
parse_pattern eof_chars (concat_patterns p (Class cl)) lexbuf
}
(* Random thought... **/* seems to be equal to True *)
| "/**/" (* / | /\Sigma^*/ *)
{ let q = Union[slash; Concat(slash, Concat(Star any, slash)) ] in
parse_pattern eof_chars (concat_patterns p q) lexbuf }
| "/**" (* \varepsilon | /\Sigma^* *)
{ let q = Union[Epsilon; Concat(slash, Star any)] in
parse_pattern eof_chars (concat_patterns p q) lexbuf }
| "**/" (* \varepsilon | \Sigma^*/ *)
{ let q = Union[Epsilon; Concat(Star any, slash)] in
parse_pattern eof_chars (concat_patterns p q) lexbuf }
| "**" { raise (Parse_error("Ambiguous ** pattern not allowed unless surrounded by one or more slashes")) }
| '*' { parse_pattern eof_chars (concat_patterns p (Star not_slash)) lexbuf }
| '/' { parse_pattern eof_chars (concat_patterns p slash) lexbuf }
| '?' { parse_pattern eof_chars (concat_patterns p not_slash) lexbuf }
| _ as c
{ if List.mem c eof_chars then
(p,c)
else
raise (Parse_error(sf "Unexpected character %C in glob pattern" c))
}
and parse_string b = parse
| "\"" { Buffer.contents b }
| "\\\"" { Buffer.add_char b '"'; parse_string b lexbuf }
| [^'"' '\\']+ as u { Buffer.add_string b u; parse_string b lexbuf }
| _ as c { raise (Parse_error(sf "Unexpected character %C in string" c)) }
and parse_class cl = parse
| ']' { cl }
| "-]" { ((Atom('-','-'))::cl) }
| (_ as c1) '-' (_ as c2) { parse_class ((Atom(c1,c2))::cl) lexbuf }
| _ as c { parse_class ((Atom(c,c))::cl) lexbuf }

28
ocamlbuild/hooks.ml
View File

@ -1,28 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
type message =
| Before_hygiene
| After_hygiene
| Before_options
| After_options
| Before_rules
| After_rules
let hooks = ref ignore
let setup_hooks f = hooks := f
let call_hook m = !hooks m

25
ocamlbuild/hooks.mli
View File

@ -1,25 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
type message =
| Before_hygiene
| After_hygiene
| Before_options
| After_options
| Before_rules
| After_rules
val setup_hooks : (message -> unit) -> unit
val call_hook : message -> unit

177
ocamlbuild/hygiene.ml
View File

@ -1,177 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Hygiene *)
open My_std
open Slurp
exception Exit_hygiene_violations
type rule =
| Implies_not of pattern * pattern
| Not of pattern
and pattern = suffix
and suffix = string
type penalty = Warn | Fail
type law = {
law_name : string;
law_rules : rule list;
law_penalty : penalty
}
let list_collect f l =
let rec loop result = function
| [] -> List.rev result
| x :: rest ->
match f x with
| None -> loop result rest
| Some y -> loop (y :: result) rest
in
loop [] l
let list_none_for_all f l =
let rec loop = function
| [] -> None
| x :: rest ->
match f x with
| None -> loop rest
| y -> y
in
loop l
let sf = Printf.sprintf
module SS = Set.Make(String);;
let check ?sanitize laws entry =
let penalties = ref [] in
let microbes = ref SS.empty in
let () =
match sanitize with
| Some fn -> if sys_file_exists fn then sys_remove fn
| None -> ()
in
let remove path name =
if sanitize <> None then
microbes := SS.add (filename_concat path name) !microbes
in
let check_rule = fun entries -> function
| Not suffix ->
list_collect
begin function
| File(path, name, _, true) ->
if Filename.check_suffix name suffix
&& not ( Pathname.link_to_dir (filename_concat path name) !Options.build_dir ) then
begin
remove path name;
Some(sf "File %s in %s has suffix %s" name path suffix)
end
else
None
| File _ | Dir _| Error _ | Nothing -> None
end
entries
| Implies_not(suffix1, suffix2) ->
list_collect
begin function
| File(path, name, _, true) ->
if Filename.check_suffix name suffix1 then
begin
let base = Filename.chop_suffix name suffix1 in
let name' = base ^ suffix2 in
if List.exists
begin function
| File(_, name'', _, true) -> name' = name''
| File _ | Dir _ | Error _ | Nothing -> false
end
entries
then
begin
remove path name';
Some(sf "Files %s and %s should not be together in %s" name name' path)
end
else
None
end
else
None
| File _ | Dir _ | Error _ | Nothing -> None
end
entries
in
let rec check_entry = function
| Dir(_,_,_,true,entries) ->
List.iter
begin fun law ->
match List.concat (List.map (check_rule !*entries) law.law_rules) with
| [] -> ()
| explanations ->
penalties := (law, explanations) :: !penalties
end
laws;
List.iter check_entry !*entries
| Dir _ | File _ | Error _ | Nothing -> ()
in
check_entry entry;
begin
let microbes = !microbes in
if not (SS.is_empty microbes) then
begin
match sanitize with
| None ->
Log.eprintf "sanitize: the following are files that should probably not be in your\n\
source tree:\n";
SS.iter
begin fun fn ->
Log.eprintf " %s" fn
end
microbes;
Log.eprintf "Remove them manually, don't use the -no-sanitize option, use -no-hygiene, or\n\
define hygiene exceptions using the tags or plugin mechanism.\n";
raise Exit_hygiene_violations
| Some fn ->
let m = SS.cardinal microbes in
Log.eprintf
"@[<hov 2>SANITIZE:@ a@ total@ of@ %d@ file%s@ that@ should@ probably\
@ not@ be@ in@ your@ source@ tree@ has@ been@ found.\
@ A@ script@ shell@ file@ %S@ is@ being@ created.\
@ Check@ this@ script@ and@ run@ it@ to@ remove@ unwanted@ files\
@ or@ use@ other@ options@ (such@ as@ defining@ hygiene@ exceptions\
@ or@ using@ the@ -no-hygiene@ option).@]"
m (if m = 1 then "" else "s") fn;
let oc = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o777 fn in
(* See PR #5338: under mingw, one produces a shell script, which must follow
Unix eol convention; hence Open_binary. *)
let fp = Printf.fprintf in
fp oc "#!/bin/sh\n\
# File generated by ocamlbuild\n\
\n\
cd %s\n\
\n" (Shell.quote_filename_if_needed Pathname.pwd);
SS.iter
begin fun fn ->
fp oc "rm -f %s\n" (Shell.quote_filename_if_needed fn)
end
microbes;
(* Also clean itself *)
fp oc "# Also clean the script itself\n";
fp oc "rm -f %s\n" (Shell.quote_filename_if_needed fn);
close_out oc
end;
!penalties
end
;;

48
ocamlbuild/hygiene.mli
View File

@ -1,48 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Hygiene *)
(** Module for checking that the source tree is not polluted by object files. *)
(** Sanity rules to abide. Not to be confused with compilation rules. *)
type rule =
Implies_not of pattern * pattern (** The rule [Implies_not(".mll",".ml")] is broken if there is a file [foo.mll]
together with a file [foo.ml] int the same directory. The second file can
get sanitized. *)
| Not of pattern (* No files with suffix [pattern] will be tolerated. *)
(** Suffix matching is enough for the purpose of this module. *)
and pattern = suffix
(** And a suffix is a string. *)
and suffix = string
(** A warning is simply displayed. A failures stops the compilation. *)
type penalty = Warn | Fail
(** This type is used to encode laws that will be checked by this module. *)
type law = {
law_name : string; (** The name of the law that will be printed when it is violated. *)
law_rules : rule list; (** Breaking any of these rules is breaking this law. *)
law_penalty : penalty; (** Breaking the law gives you either a warning or a failure. *)
}
(** [check ~sanitize laws entry] will scan the directory tree [entry] for violation to the given [laws].
Any warnings or errors will be printed on the [stdout]. If [sanitize] is [Some fn], a shell script will be written
into the file [fn] with commands to delete the offending files. The command will return a pair [(fatal, penalties)]
where [fatal] is [true] when serious hygiene violations have been spotted, and [penalties] is a list of laws and
messages describing the offenses. *)
val check : ?sanitize:string -> law list -> bool Slurp.entry -> (law * string list) list

49
ocamlbuild/lexers.mli
View File

@ -1,49 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
exception Error of (string * Loc.location)
type conf_values =
{ plus_tags : (string * Loc.location) list;
minus_tags : (string * Loc.location) list }
type conf = (Glob.globber * conf_values) list
val ocamldep_output : Loc.source -> Lexing.lexbuf -> (string * string list) list
val space_sep_strings : Loc.source -> Lexing.lexbuf -> string list
val blank_sep_strings : Loc.source -> Lexing.lexbuf -> string list
val comma_sep_strings : Loc.source -> Lexing.lexbuf -> string list
val comma_or_blank_sep_strings : Loc.source -> Lexing.lexbuf -> string list
val trim_blanks : Loc.source -> Lexing.lexbuf -> string
(* Parse an environment path (i.e. $PATH).
This is a colon separated string.
Note: successive colons means an empty string.
Example:
":aaa:bbb:::ccc:" -> [""; "aaa"; "bbb"; ""; ""; "ccc"; ""] *)
val parse_environment_path : Loc.source -> Lexing.lexbuf -> string list
(* Same one, for Windows (PATH is ;-separated) *)
val parse_environment_path_w : Loc.source -> Lexing.lexbuf -> string list
val conf_lines : string option -> Loc.source -> Lexing.lexbuf -> conf
val path_scheme : bool -> Loc.source -> Lexing.lexbuf ->
[ `Word of string
| `Var of (string * Glob.globber)
] list
val ocamlfind_query : Loc.source -> Lexing.lexbuf ->
string * string * string * string * string * string
val tag_gen : Loc.source -> Lexing.lexbuf -> string * string option

192
ocamlbuild/lexers.mll
View File

@ -1,192 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
{
exception Error of (string * Loc.location)
let error source lexbuf fmt =
Printf.ksprintf (fun s ->
raise (Error (s, Loc.of_lexbuf source lexbuf))
) fmt
open Glob_ast
type conf_values =
{ plus_tags : (string * Loc.location) list;
minus_tags : (string * Loc.location) list }
type conf = (Glob.globber * conf_values) list
let empty = { plus_tags = []; minus_tags = [] }
let locate source lexbuf txt =
(txt, Loc.of_lexbuf source lexbuf)
let sublex lexer s = lexer (Lexing.from_string s)
}
let newline = ('\n' | '\r' | "\r\n")
let space = [' ' '\t' '\012']
let space_or_esc_nl = (space | '\\' newline)
let sp = space_or_esc_nl
let blank = newline | space
let not_blank = [^' ' '\t' '\012' '\n' '\r']
let not_space_nor_comma = [^' ' '\t' '\012' ',']
let not_newline = [^ '\n' '\r' ]
let not_newline_nor_colon = [^ '\n' '\r' ':' ]
let normal_flag_value = [^ '(' ')' '\n' '\r']
let normal = [^ ':' ',' '(' ')' ''' ' ' '\n' '\r']
let tag = normal+ | ( normal+ ':' normal+ ) | normal+ '(' [^ ')' ]* ')'
let variable = [ 'a'-'z' 'A'-'Z' '_' '-' '0'-'9' ]*
let pattern = ([^ '(' ')' '\\' ] | '\\' [ '(' ')' ])*
rule ocamldep_output source = parse
| ([^ ':' '\n' '\r' ]+ as k) ':' { let x = (k, space_sep_strings_nl source lexbuf) in x :: ocamldep_output source lexbuf }
| eof { [] }
| _ { error source lexbuf "Expecting colon followed by space-separated module name list" }
and space_sep_strings_nl source = parse
| space* (not_blank+ as word) { word :: space_sep_strings_nl source lexbuf }
| space* newline { Lexing.new_line lexbuf; [] }
| _ { error source lexbuf "Expecting space-separated strings terminated with newline" }
and space_sep_strings source = parse
| space* (not_blank+ as word) { word :: space_sep_strings source lexbuf }
| space* newline? eof { [] }
| _ { error source lexbuf "Expecting space-separated strings" }
and blank_sep_strings source = parse
| blank* '#' not_newline* newline { blank_sep_strings source lexbuf }
| blank* '#' not_newline* eof { [] }
| blank* (not_blank+ as word) { word :: blank_sep_strings source lexbuf }
| blank* eof { [] }
| _ { error source lexbuf "Expecting blank-separated strings" }
and comma_sep_strings source = parse
| space* (not_space_nor_comma+ as word) space* eof { [word] }
| space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux source lexbuf }
| space* eof { [] }
| _ { error source lexbuf "Expecting comma-separated strings (1)" }
and comma_sep_strings_aux source = parse
| space* ',' space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux source lexbuf }
| space* eof { [] }
| _ { error source lexbuf "Expecting comma-separated strings (2)" }
and comma_or_blank_sep_strings source = parse
| space* (not_space_nor_comma+ as word) space* eof { [word] }
| space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux source lexbuf }
| space* eof { [] }
| _ { error source lexbuf "Expecting (comma|blank)-separated strings (1)" }
and comma_or_blank_sep_strings_aux source = parse
| space* ',' space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux source lexbuf }
| space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux source lexbuf }
| space* eof { [] }
| _ { error source lexbuf "Expecting (comma|blank)-separated strings (2)" }
and parse_environment_path_w source = parse
| ([^ ';']* as word) { word :: parse_environment_path_aux_w source lexbuf }
| ';' ([^ ';']* as word) { "" :: word :: parse_environment_path_aux_w source lexbuf }
| eof { [] }
and parse_environment_path_aux_w source = parse
| ';' ([^ ';']* as word) { word :: parse_environment_path_aux_w source lexbuf }
| eof { [] }
| _ { error source lexbuf "Impossible: expecting colon-separated strings" }
and parse_environment_path source = parse
| ([^ ':']* as word) { word :: parse_environment_path_aux source lexbuf }
| ':' ([^ ':']* as word) { "" :: word :: parse_environment_path_aux source lexbuf }
| eof { [] }
and parse_environment_path_aux source = parse
| ':' ([^ ':']* as word) { word :: parse_environment_path_aux source lexbuf }
| eof { [] }
| _ { error source lexbuf "Impossible: expecting colon-separated strings" }
and conf_lines dir source = parse
| space* '#' not_newline* newline { Lexing.new_line lexbuf; conf_lines dir source lexbuf }
| space* '#' not_newline* eof { [] }
| space* newline { Lexing.new_line lexbuf; conf_lines dir source lexbuf }
| space* eof { [] }
| space* (not_newline_nor_colon+ as k) (sp* as s1) ':' (sp* as s2)
{
let bexpr =
try Glob.parse ?dir k
with exn -> error source lexbuf "Invalid globbing pattern %S" k (Printexc.to_string exn)
in
sublex (count_lines lexbuf) s1; sublex (count_lines lexbuf) s2;
let v1 = conf_value empty source lexbuf in
let v2 = conf_values v1 source lexbuf in
let rest = conf_lines dir source lexbuf in (bexpr,v2) :: rest
}
| _ { error source lexbuf "Invalid line syntax" }
and conf_value x source = parse
| '-' (tag as tag) { { (x) with minus_tags = locate source lexbuf tag :: x.minus_tags } }
| '+'? (tag as tag) { { (x) with plus_tags = locate source lexbuf tag :: x.plus_tags } }
| (_ | eof) { error source lexbuf "Invalid tag modifier only '+ or '-' are allowed as prefix for tag" }
and conf_values x source = parse
| (sp* as s1) ',' (sp* as s2) {
sublex (count_lines lexbuf) s1; sublex (count_lines lexbuf) s2;
conf_values (conf_value x source lexbuf) source lexbuf
}
| newline { Lexing.new_line lexbuf; x }
| eof { x }
| _ { error source lexbuf "Only ',' separated tags are alllowed" }
and path_scheme patt_allowed source = parse
| ([^ '%' ]+ as prefix)
{ `Word prefix :: path_scheme patt_allowed source lexbuf }
| "%(" (variable as var) ')'
{ `Var (var, Bool.True) :: path_scheme patt_allowed source lexbuf }
| "%(" (variable as var) ':' (pattern as patt) ')'
{ if patt_allowed then
let patt = My_std.String.implode (unescape (Lexing.from_string patt)) in
`Var (var, Glob.parse patt) :: path_scheme patt_allowed source lexbuf
else
error source lexbuf "Patterns are not allowed in this pathname (%%(%s:%s) only in ~prod)" var patt }
| '%'
{ `Var ("", Bool.True) :: path_scheme patt_allowed source lexbuf }
| eof
{ [] }
| _ { error source lexbuf "Bad pathanme scheme" }
and unescape = parse
| '\\' (['(' ')'] as c) { c :: unescape lexbuf }
| _ as c { c :: unescape lexbuf }
| eof { [] }
and ocamlfind_query source = parse
| newline*
"package:" space* (not_newline* as n) newline+
"description:" space* (not_newline* as d) newline+
"version:" space* (not_newline* as v) newline+
"archive(s):" space* (not_newline* as a) newline+
"linkopts:" space* (not_newline* as lo) newline+
"location:" space* (not_newline* as l) newline+
{ n, d, v, a, lo, l }
| _ { error source lexbuf "Bad ocamlfind query" }
and trim_blanks source = parse
| blank* (not_blank* as word) blank* { word }
| _ { error source lexbuf "Bad input for trim_blanks" }
and tag_gen source = parse
| (normal+ as name) ('(' ([^')']* as param) ')')? { name, param }
| _ { error source lexbuf "Not a valid parametrized tag" }
and count_lines lb = parse
| space* { count_lines lb lexbuf }
| '\\' newline { Lexing.new_line lb; count_lines lb lexbuf }
| eof { () }

35
ocamlbuild/loc.ml
View File

@ -1,35 +0,0 @@
(* it's not worth adding a dependency on parsing/location.ml(i) or
compilerlibs just to support location printing, so we re-implement
that here *)
open Lexing
(* We use a loosely structural type so that this bit of code can be
easily reused by project that would wish it, without introducing
any type-compatibility burden. *)
type source = string (* "file", "environment variable", "command-line option" ... *)
type location = source * position * position
let file loc = loc.pos_fname
let line loc = loc.pos_lnum
let char loc = loc.pos_cnum - loc.pos_bol
let print_loc ppf (source, start, end_) =
let open Format in
let print one_or_two ppf (start_num, end_num) =
if one_or_two then fprintf ppf " %d" start_num
else fprintf ppf "s %d-%d" start_num end_num in
fprintf ppf "%s %S, line%a, character%a:@."
(String.capitalize_ascii source)
(file start)
(print (line start = line end_))
(line start, line end_)
(print (line start = line end_ && char start = char end_))
(char start, char end_)
let of_lexbuf source lexbuf =
(source, lexbuf.lex_start_p, lexbuf.lex_curr_p)
let print_loc_option ppf = function
| None -> ()
| Some loc -> print_loc ppf loc

7
ocamlbuild/loc.mli
View File

@ -1,7 +0,0 @@
type source = string
type location = source * Lexing.position * Lexing.position
val print_loc : Format.formatter -> location -> unit
val print_loc_option : Format.formatter -> location option -> unit
val of_lexbuf : source -> Lexing.lexbuf -> location

81
ocamlbuild/log.ml
View File

@ -1,81 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
module Debug = struct
let mode _ = true
end
include Debug
let level = ref 1
let classic_display = ref false
let internal_display = ref None
let failsafe_display = lazy (Display.create ~mode:`Classic ~log_level:!level ())
let ( !- ) r =
match !r with
| None -> !*failsafe_display
| Some x -> x
let init log_file =
let mode =
if !classic_display || !*My_unix.is_degraded || !level <= 0 || not (My_unix.stdout_isatty ()) then
`Classic
else
`Sophisticated
in
internal_display := Some (Display.create ~mode ?log_file ~log_level:!level ())
let raw_dprintf log_level = Display.dprintf ~raw:true ~log_level !-internal_display
let dprintf log_level fmt = Display.dprintf ~log_level !-internal_display fmt
let is_logging log_level = Display.is_logging !-internal_display log_level
let eprintf fmt = dprintf (-1) fmt
let update () = Display.update !-internal_display
let event ?pretend x = Display.event !-internal_display ?pretend x
let display x = Display.display !-internal_display x
let do_at_end = Queue.create ()
let already_asked = Hashtbl.create 10
let at_end_always ~name thunk =
if not (Hashtbl.mem already_asked name) then begin
Hashtbl.add already_asked name ();
Queue.add thunk do_at_end;
end
let at_end ~name thunk = at_end_always ~name (function
| `Quiet -> ()
| `Success | `Error -> thunk `Error)
let at_failure ~name thunk = at_end_always ~name (function
| `Success | `Quiet -> ()
| `Error -> thunk `Error)
let finish ?how () =
while not (Queue.is_empty do_at_end) do
let actions = Queue.copy do_at_end in
Queue.clear do_at_end;
(* calling a thunk may add new actions again, hence the loop *)
Queue.iter (fun thunk ->
thunk (match how with None -> `Quiet | Some how -> how)
) actions;
done;
match !internal_display with
| None -> ()
| Some d -> Display.finish ?how d
(*let () = My_unix.at_exit_once finish*)

45
ocamlbuild/log.mli
View File

@ -1,45 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(* Log *)
(** Module for modulating the logging output with the logging level. *)
include Signatures.LOG
(** Turn it to true to have a classic display of commands. *)
val classic_display : bool ref
(** See {Display.event}. *)
val event : ?pretend:bool -> string -> string -> Tags.t -> unit
(**/**)
(** Initialize the Log module given a log file name. *)
val init : string option -> unit
val finish : ?how:[`Success|`Error|`Quiet] -> unit -> unit
val display : (out_channel -> unit) -> unit
val update : unit -> unit
val mode : string -> bool
(** Wrap logging event so that only fire at the end of the compilation
process, possibly depending on the termination status.
The name is used to avoid printing the same hint/warning twice,
even if [at_end] is called several times. Use different names for
distinct events.
*)
val at_end : name:string -> ([> `Error | `Quiet ] -> unit) -> unit
val at_failure : name:string -> ([> `Error ] -> unit) -> unit

359
ocamlbuild/main.ml
View File

@ -1,359 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
open My_std
open Log
open Pathname.Operators
open Command
open Tools
open Ocaml_specific
open Format
;;
exception Exit_build_error of string
exception Exit_silently
let clean () =
Shell.rm_rf !Options.build_dir;
if !Options.make_links then begin
let entry =
Slurp.map (fun _ _ _ -> true)
(Slurp.slurp Filename.current_dir_name)
in
Slurp.force (Resource.clean_up_links entry)
end;
Log.finish ();
raise Exit_silently
;;
let show_tags () =
if List.length !Options.show_tags > 0 then
Log.eprintf "Warning: the following tags do not include \
dynamically-generated tags, such as link, compile, pack, byte, native, c, \
pdf... (this list is by no means exhaustive).\n";
List.iter begin fun path ->
Log.eprintf "@[<2>Tags for %S:@ {. %a .}@]" path Tags.print (tags_of_pathname path)
end !Options.show_tags
;;
let show_documentation () =
Rule.show_documentation ();
Flags.show_documentation ();
;;
(* these tags are used in an ad-hoc way by the ocamlbuild implementation;
this means that even if they were not part of any flag declaration,
they should be marked as useful, to avoid the "unused tag" warning. *)
let builtin_useful_tags =
Tags.of_list [
"include"; "traverse"; "not_hygienic"; "precious";
"pack"; "ocamlmklib"; "native"; "thread";
"nopervasives"; "use_menhir"; "ocamldep";
"thread";
]
;;
let proceed () =
Hooks.call_hook Hooks.Before_options;
Options.init ();
Options.include_dirs := List.map Pathname.normalize !Options.include_dirs;
Options.exclude_dirs := List.map Pathname.normalize !Options.exclude_dirs;
if !Options.must_clean then clean ();
Hooks.call_hook Hooks.After_options;
let options_wd = Sys.getcwd () in
let first_run_for_plugin =
(* If we are in the first run before launching the plugin, we
should skip the user-visible operations (hygiene) that may need
information from the plugin to run as the user expects it.
Note that we don't need to disable the [Hooks] call as they are
no-ops anyway, before any plugin has registered hooks. *)
Plugin.we_need_a_plugin () && not !Options.just_plugin in
let target_dirs = List.union [] (List.map Pathname.dirname !Options.targets) in
Configuration.parse_string ~source:Const.Source.builtin
"<**/*.ml> or <**/*.mli> or <**/*.mlpack> or <**/*.ml.depends>: ocaml\n\
<**/*.byte>: ocaml, byte, program\n\
<**/*.odoc>: ocaml, doc\n\
<**/*.native>: ocaml, native, program\n\
<**/*.cma>: ocaml, byte, library\n\
<**/*.cmxa>: ocaml, native, library\n\
<**/*.cmo>: ocaml, byte\n\
<**/*.cmi>: ocaml, byte, native\n\
<**/*.cmx>: ocaml, native\n\
<**/*.mly>: infer\n\
<**/.svn>|\".bzr\"|\".hg\"|\".git\"|\"_darcs\": -traverse\n\
";
List.iter
(Configuration.parse_string ~source:Const.Source.command_line)
!Options.tag_lines;
Configuration.tag_any !Options.tags;
if !Options.recursive || Options.ocamlbuild_project_heuristic ()
then Configuration.tag_any ["traverse"];
(* options related to findlib *)
if !Options.use_ocamlfind then
List.iter
(fun pkg ->
let tag = Param_tags.make "package" pkg in
Configuration.tag_any [tag])
!Options.ocaml_pkgs;
begin match !Options.ocaml_syntax with
| Some syntax -> Configuration.tag_any [Param_tags.make "syntax" syntax]
| None -> () end;
let newpwd = Sys.getcwd () in
Sys.chdir Pathname.pwd;
let entry_include_dirs = ref [] in
let entry =
Slurp.filter
begin fun path name () ->
let dir =
if path = Filename.current_dir_name then
None
else
Some path
in
let path_name = path/name in
if name = "_tags" then begin
let tags_path =
(* PR#6482: remember that this code is run lazily by the Slurp command,
and may run only after the working directory has been changed.
On the other hand, always using the absolute path makes
error messages longer and more frigthening in case of
syntax error in the _tags file. So we use the absolute
path only when necessary -- the working directory has
changed. *)
if Sys.getcwd () = Pathname.pwd then path_name
else Pathname.pwd / path_name in
ignore (Configuration.parse_file ?dir tags_path);
end;
(List.mem name ["_oasis"] || (String.length name > 0 && name.[0] <> '_'))
&& (name <> !Options.build_dir && not (List.mem name !Options.exclude_dirs))
&& begin
not (path_name <> Filename.current_dir_name && Pathname.is_directory path_name)
|| begin
let tags = tags_of_pathname path_name in
(if Tags.mem "include" tags
|| List.mem path_name !Options.include_dirs then
(entry_include_dirs := path_name :: !entry_include_dirs; true)
else
Tags.mem "traverse" tags
|| List.exists (Pathname.is_prefix path_name) !Options.include_dirs
|| List.exists (Pathname.is_prefix path_name) target_dirs)
&& ((* beware: !Options.build_dir is an absolute directory *)
Pathname.normalize !Options.build_dir
<> Pathname.normalize (Pathname.pwd/path_name))
end
end
end
(Slurp.slurp Filename.current_dir_name)
in
Hooks.call_hook Hooks.Before_hygiene;
let hygiene_entry =
Slurp.map begin fun path name () ->
let tags = tags_of_pathname (path/name) in
not (Tags.mem "not_hygienic" tags) && not (Tags.mem "precious" tags)
end entry in
Slurp.force hygiene_entry;
if !Options.hygiene && not first_run_for_plugin then
Fda.inspect hygiene_entry;
let entry = hygiene_entry in
Hooks.call_hook Hooks.After_hygiene;
Options.include_dirs := Pathname.current_dir_name :: List.rev !entry_include_dirs;
dprintf 3 "include directories are:@ %a" print_string_list !Options.include_dirs;
Options.entry := Some entry;
Hooks.call_hook Hooks.Before_rules;
Ocaml_specific.init ();
Hooks.call_hook Hooks.After_rules;
Sys.chdir options_wd;
Plugin.execute_plugin_if_needed ();
(* [Param_tags.init ()] is called *after* the plugin is executed, as
some of the parametrized tags present in the _tags files parsed
will be declared by the plugin, and would therefore result in
"tag X does not expect a parameter" warnings if initialized
before. Note that [Plugin.rebuild_plugin_if_needed] is careful to
partially initialize the tags that it uses for plugin compilation. *)
Param_tags.init ();
Sys.chdir newpwd;
(*let () = dprintf 0 "source_dir_path_set:@ %a" StringSet.print source_dir_path_set*)
if !Options.show_documentation then begin
show_documentation ();
raise Exit_silently
end;
let all_tags =
let builtin = builtin_useful_tags in
let used_in_flags = Flags.get_used_tags () in
let used_in_deps =
List.fold_left (fun acc (tags, _deps) -> Tags.union acc tags)
Tags.empty (Command.list_all_deps ())
in
Tags.union builtin (Tags.union used_in_flags used_in_deps) in
Configuration.check_tags_usage all_tags;
Digest_cache.init ();
Sys.catch_break true;
show_tags ();
let targets =
List.map begin fun starget ->
let starget = Resource.import starget in
let target = path_and_context_of_string starget in
let ext = Pathname.get_extension starget in
(target, starget, ext)
end !Options.targets in
try
let targets =
List.map begin fun (target, starget, ext) ->
Shell.mkdir_p (Pathname.dirname starget);
let target = Solver.solve_target starget target in
(target, ext)
end targets in
Command.dump_parallel_stats ();
Log.finish ();
Shell.chdir Pathname.pwd;
let call spec = sys_command (Command.string_of_command_spec spec) in
let cmds =
List.fold_right begin fun (target, ext) acc ->
let cmd = !Options.build_dir/target in
let link x =
if !Options.make_links then
ignore (call (S [A"ln"; A"-sf"; P x; A Pathname.pwd]))
in
match ext with
| "byte" | "native" | "top" ->
link cmd; cmd :: acc
| "html" ->
link (Pathname.dirname cmd); acc
| _ ->
if !Options.program_to_execute then
eprintf "Warning: Won't execute %s whose extension is neither .byte nor .native" cmd;
acc
end targets [] in
if !Options.program_to_execute then
begin
match List.rev cmds with
| [] -> raise (Exit_usage "Using -- requires one target");
| cmd :: rest ->
if rest <> [] then dprintf 0 "Warning: Using -- only run the last target";
let cmd_spec = S [P cmd; atomize !Options.program_args] in
dprintf 3 "Running the user command:@ %a" Pathname.print cmd;
raise (Exit_with_code (call cmd_spec)) (* Exit with the exit code of the called command *)
end
else
()
with
| Ocaml_dependencies.Circular_dependencies(cycle, p) ->
raise
(Exit_build_error
(sbprintf "@[<2>Circular dependencies: %S already seen in@ %a@]@." p pp_l cycle))
;;
open Exit_codes;;
let main () =
let exit rc =
Log.finish ~how:(if rc <> 0 then `Error else `Success) ();
Pervasives.exit rc
in
try
proceed ()
with e ->
if !Options.catch_errors then
try raise e with
| Exit_OK -> exit rc_ok
| Fda.Exit_hygiene_failed ->
Log.eprintf "Exiting due to hygiene violations.";
exit rc_hygiene
| Exit_usage u ->
Log.eprintf "Usage:@ %s." u;
exit rc_usage
| Exit_system_error msg ->
Log.eprintf "System error:@ %s." msg;
exit rc_system_error
| Exit_with_code rc ->
exit rc
| Exit_silently ->
Log.finish ~how:`Quiet ();
Pervasives.exit rc_ok
| Exit_silently_with_code rc ->
Log.finish ~how:`Quiet ();
Pervasives.exit rc
| Solver.Failed backtrace ->
Log.raw_dprintf (-1) "@[<v0>@[<2>Solver failed:@ %a@]@."
Report.print_backtrace_analyze backtrace;
Log.raw_dprintf 1 "@[<v2>Backtrace:%a@]@]@."
Report.print_backtrace backtrace;
exit rc_solver_failed
| Failure s ->
Log.eprintf "Failure:@ %s." s;
exit rc_failure
| Solver.Circular(r, rs) ->
Log.eprintf "Circular build detected@ (%a already seen in %a)"
Resource.print r (List.print Resource.print) rs;
exit rc_circularity
| Invalid_argument s ->
Log.eprintf
"INTERNAL ERROR: Invalid argument %s\n\
This is likely to be a bug, please report this to the ocamlbuild\n\
developers." s;
exit rc_invalid_argument
| Ocaml_utils.Ocamldep_error msg ->
Log.eprintf "Ocamldep error: %s" msg;
exit rc_ocamldep_error
| Lexers.Error (msg,loc) ->
Log.eprintf "%aLexing error: %s." Loc.print_loc loc msg;
exit rc_lexing_error
| Arg.Bad msg ->
Log.eprintf "%s" msg;
exit rc_usage
| Exit_build_error msg ->
Log.eprintf "%s" msg;
exit rc_build_error
| Arg.Help msg ->
Log.eprintf "%s" msg;
exit rc_ok
| e ->
try
Log.eprintf "%a" My_unix.report_error e;
exit 100
with
| e ->
Log.eprintf "Exception@ %s." (Printexc.to_string e);
exit 100
else raise e
;;

16
ocamlbuild/main.mli
View File

@ -1,16 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val main : unit -> unit

268
ocamlbuild/man/ocamlbuild.1
View File

@ -1,268 +0,0 @@
.\"***********************************************************************)
.\"* *)
.\"* ocamlbuild *)
.\"* *)
.\"* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
.\"* *)
.\"* Copyright 2007 Institut National de Recherche en Informatique et *)
.\"* en Automatique. All rights reserved. This file is distributed *)
.\"* under the terms of the Q Public License version 1.0. *)
.\"* *)
.\"***********************************************************************)
.\"
.TH OCAMLBUILD 1
.SH NAME
ocamlbuild \- The OCaml project compilation tool
.SH SYNOPSIS
.B ocamlbuild
[
.B \-Is \ dir1,...
]
[
.BI \-libs \ lib1,...
]
[
.BI \-lflags \ flag1,...
]
[
.BI \-pp \ flags
]
[
.BI \-tags \ tag1,...
]
[
.B \-j \ parallel-jobs
]
.I target.native
[
.B \-\- arg1 arg2 ...
]
.I (same options)
.SH DESCRIPTION
.BR ocamlbuild (1)
orchestrates the compilation process of your OCaml project. It is similar
in function to
.BR make (1)
except that it is tailor-made to automatically compile most OCaml projects
with very little user input.
.BR ocamlbuild
should be invoked in the root of a clean project tree (e.g., with no leftover
compilation files). Given one or more targets to compile, it scans the required
subdirectories to gather information about the various files present, running
tools such as
.BR ocamldep (1)
to extract dependency information, and gathering optional files that fine-tune
its behaviour.
Target names are very significant.
.SH TARGET NAMES
.BR ocamlbuild
uses a set of target naming conventions to select the kind of objects to
produce. Target names are of the form
.BR base.extension
where
.BR base
is usually the name of the underlying OCaml module and
.BR extension
denotes the kind of object to produce from that file -- a byte code executable,
a native executable, documentation...
Of course extensions such as
.BR .cmo,
.BR .cma,
.BR .cmi...
map to their usual counterparts. Here is a list of the most important
.BR ocamlbuild \&-specific
extensions:
.TP 2i
.B .native
Native code executable
.TP 2i
.B .byte
Byte code executable
.TP 2i
.B .inferred.mli
Interface inferred with
.BR ocamlc -i
.TP 2i
.B .docdir/index.html
HTML documentation generated with
.BR ocamldoc
.PP
.SH OPTIONS
The following command-line options are recognized by
.BR ocamlbuild (1).
.TP
\fB\-version\fR
Display the version
.TP
\fB\-quiet\fR
Make as quiet as possible
.TP
\fB\-verbose\fR <level>
Set the verbose level
.TP
\fB\-documentation\fR
Show rules and flags
.TP
\fB\-log\fR <file>
Set log file
.TP
\fB\-no\-log\fR
No log file
.TP
\fB\-clean\fR
Remove build directory and other files, then exit
.TP
\fB\-I\fR <path>
Add to include directories
.TP
\fB\-Is\fR <path,...>
(same as above, but accepts a comma\-separated list)
.TP
\fB\-X\fR <path>
Directory to ignore
.TP
\fB\-Xs\fR <path,...>
(idem)
.TP
\fB\-lib\fR <flag>
Link to this ocaml library
.TP
\fB\-libs\fR <flag,...>
(idem)
.TP
\fB\-lflag\fR <flag>
Add to ocamlc link flags
.TP
\fB\-lflags\fR <flag,...>
(idem)
.TP
\fB\-cflag\fR <flag>
Add to ocamlc compile flags
.TP
\fB\-cflags\fR <flag,...>
(idem)
.TP
\fB\-yaccflag\fR <flag>
Add to ocamlyacc flags
.TP
\fB\-yaccflags\fR <flag,...>
(idem)
.TP
\fB\-lexflag\fR <flag>
Add to ocamllex flags
.TP
\fB\-lexflags\fR <flag,...>
(idem)
.TP
\fB\-ppflag\fR <flag>
Add to ocaml preprocessing flags
.TP
\fB\-pp\fR <flag,...>
(idem)
.TP
\fB\-tag\fR <tag>
Add to default tags
.TP
\fB\-tags\fR <tag,...>
(idem)
.TP
\fB\-ignore\fR <module,...>
Don't try to build these modules
.TP
\fB\-no\-links\fR
Don't make links of produced final targets
.TP
\fB\-no\-skip\fR
Don't skip modules that are requested by ocamldep but cannot be built
.TP
\fB\-no\-hygiene\fR
Don't apply sanity\-check rules
.TP
\fB\-no\-plugin\fR
Don't build myocamlbuild.ml
.TP
\fB\-no\-stdlib\fR
Don't ignore stdlib modules
.TP
\fB\-just\-plugin\fR
Just build myocamlbuild.ml
.TP
\fB\-byte\-plugin\fR
Don't use a native plugin but bytecode
.TP
\fB\-no-sanitize\fR
Do not enforce sanity\-check rules
.TP
\fB\-nothing\-should\-be\-rebuilt\fR
Fail if something needs to be rebuilt
.TP
\fB\-classic\-display\fR
Display executed commands the old\-fashioned way
.TP
\fB\-j\fR <N>
Allow N jobs at once (0 for unlimited)
.TP
\fB\-build\-dir\fR <path>
Set build directory
.TP
\fB\-install\-dir\fR <path>
Set the install directory
.TP
\fB\-where\fR
Display the install directory
.TP
\fB\-ocamlc\fR <command>
Set the OCaml bytecode compiler
.TP
\fB\-ocamlopt\fR <command>
Set the OCaml native compiler
.TP
\fB\-ocamldep\fR <command>
Set the OCaml dependency tool
.TP
\fB\-ocamldoc\fR <command>
Set the OCaml documentation generator
.TP
\fB\-ocamlyacc\fR <command>
Set the ocamlyacc tool
.TP
\fB\-ocamllex\fR <command>
Set the ocamllex tool
.TP
\fB\-ocamlrun\fR <command>
Set the ocamlrun tool
.TP
\fB\-\-\fR
Stop argument processing, remaining arguments are given to the user program
.TP
\fB\-help\fR
Display the list of options
.TP
\fB\-\-help\fR
Display the list of options
.PP
.SH SEE ALSO
The
.BR ocamlbuild
manual,
.BR ocaml (1),
.BR make (1).
.br
.I The OCaml user's manual, chapter "Batch compilation".

103
ocamlbuild/misc/opentracer.ml
View File

@ -1,103 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
open My_std
module type TRACER = sig
(** Call the given command using the tracer, it returns the exit status. *)
val call : string -> string list -> StringSet.t * Unix.process_status
end
module Ktrace = struct
let process_line line (wait_a_string, set) =
let strings = Lexers.space_sep_strings (Lexing.from_string line) in
if wait_a_string then
match strings with
| [_; _; "NAMI"; file] -> false, StringSet.add file set
| _ -> failwith (Printf.sprintf "unexpected ktrace output line (%S)" line)
else
match strings with
| [_; _; "CALL"; fct] ->
(String.length fct > 5 && String.sub fct 0 5 = "open("), set
| _ -> false, set
let call cmd args =
let tmp = Filename.temp_file "ktrace" "out" in
match Unix.fork () with
| 0 -> Unix.execvp "ktrace" (Array.of_list("-d"::"-i"::"-t"::"nc"::"-f"::tmp::cmd::args))
| pid ->
let _, st = Unix.waitpid [] pid in
let ic = Unix.open_process_in (Printf.sprintf "kdump -f %s" (Filename.quote tmp)) in
let close () = ignore (Unix.close_process_in ic); Sys.remove tmp in
let set =
try
let rec loop acc =
match try Some (input_line ic) with End_of_file -> None with
| Some line -> loop (process_line line acc)
| None -> acc in
let _, set = loop (false, StringSet.empty) in
close ();
set
with e -> (close (); raise e)
in set, st
end
module Driver (T : TRACER) = struct
let usage () =
Printf.eprintf "Usage: %s [-a <authorized_file>]* <cmd> <args>*\n%!" Sys.argv.(0);
exit 2
let main () =
let log = "opentracer.log" in
let oc =
if sys_file_exists log then
open_out_gen [Open_wronly;Open_append;Open_text] 0 log
else
let oc = open_out log in
let () = output_string oc "---\n" in
oc in
let rec loop acc =
function
| "-a" :: file :: rest -> loop (StringSet.add file acc) rest
| "-a" :: _ -> usage ()
| "--" :: cmd :: args -> acc, cmd, args
| cmd :: args -> acc, cmd, args
| [] -> usage () in
let authorized_files, cmd, args =
loop StringSet.empty (List.tl (Array.to_list Sys.argv)) in
let opened_files, st = T.call cmd args in
let forbidden_files = StringSet.diff opened_files authorized_files in
if not (StringSet.is_empty forbidden_files) then begin
Printf.fprintf oc "- cmd: %s\n args:\n%!" cmd;
let pp = Printf.fprintf oc " - %s\n%!" in
List.iter pp args;
Printf.fprintf oc " forbidden_files:\n%!";
StringSet.iter pp forbidden_files;
end;
close_out oc;
match st with
| Unix.WEXITED st -> exit st
| Unix.WSIGNALED s | Unix.WSTOPPED s -> Unix.kill (Unix.getpid ()) s
end
let main =
(* match os with *)
(* | "macos" -> *)
let module M = Driver(Ktrace) in M.main
(* | "linux" -> *)
(* let module M = Driver(Strace) in M.main *)
let () = main ()

432
ocamlbuild/my_std.ml
View File

@ -1,432 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open Format
exception Exit_OK
exception Exit_usage of string
exception Exit_system_error of string
exception Exit_with_code of int
exception Exit_silently_with_code of int
module Outcome = struct
type ('a,'b) t =
| Good of 'a
| Bad of 'b
let ignore_good =
function
| Good _ -> ()
| Bad e -> raise e
let good =
function
| Good x -> x
| Bad exn -> raise exn
let wrap f x =
try Good (f x) with e -> Bad e
end
let opt_print elt ppf =
function
| Some x -> fprintf ppf "@[<2>Some@ %a@]" elt x
| None -> pp_print_string ppf "None"
open Format
let ksbprintf g fmt =
let buff = Buffer.create 42 in
let f = formatter_of_buffer buff in
kfprintf (fun f -> (pp_print_flush f (); g (Buffer.contents buff))) f fmt
let sbprintf fmt = ksbprintf (fun x -> x) fmt
(** Some extensions of the standard library *)
module Set = struct
module type OrderedTypePrintable = sig
include Set.OrderedType
val print : formatter -> t -> unit
end
module type S = sig
include Set.S
val find_elt : (elt -> bool) -> t -> elt
val map : (elt -> elt) -> t -> t
val of_list : elt list -> t
val print : formatter -> t -> unit
end
module Make (M : OrderedTypePrintable) : S with type elt = M.t = struct
include Set.Make(M)
exception Found of elt
let find_elt p set =
try
iter begin fun elt ->
if p elt then raise (Found elt)
end set; raise Not_found
with Found elt -> elt
let map f set = fold (fun x -> add (f x)) set empty
let of_list l = List.fold_right add l empty
let print f s =
let () = fprintf f "@[<hv0>@[<hv2>{.@ " in
let _ =
fold begin fun elt first ->
if not first then fprintf f ",@ ";
M.print f elt;
false
end s true in
fprintf f "@]@ .}@]"
end
end
module List = struct
include List
let print pp_elt f ls =
fprintf f "@[<2>[@ ";
let _ =
fold_left begin fun first elt ->
if not first then fprintf f ";@ ";
pp_elt f elt;
false
end true ls in
fprintf f "@ ]@]"
let filter_opt f xs =
List.fold_right begin fun x acc ->
match f x with
| Some x -> x :: acc
| None -> acc
end xs []
let rec rev_append_uniq acc =
function
| [] -> acc
| x :: xs ->
if mem x acc then rev_append_uniq acc xs
else rev_append_uniq (x :: acc) xs
let union a b =
rev (rev_append_uniq (rev_append_uniq [] a) b)
let ordered_unique (type el) (lst : el list) =
let module Set = Set.Make(struct
type t = el
let compare = Pervasives.compare
let print _ _ = ()
end)
in
let _, lst =
List.fold_left (fun (set,acc) el ->
if Set.mem el set
then set, acc
else Set.add el set, el :: acc) (Set.empty,[]) lst
in
List.rev lst
end
module String = struct
include String
let print f s = fprintf f "%S" s
let chomp s =
let is_nl_char = function '\n' | '\r' -> true | _ -> false in
let rec cut n =
if n = 0 then 0 else if is_nl_char s.[n-1] then cut (n-1) else n
in
let ls = length s in
let n = cut ls in
if n = ls then s else sub s 0 n
let before s pos = sub s 0 pos
let after s pos = sub s pos (length s - pos)
let first_chars s n = sub s 0 n
let last_chars s n = sub s (length s - n) n
let rec eq_sub_strings s1 p1 s2 p2 len =
if len > 0 then s1.[p1] = s2.[p2] && eq_sub_strings s1 (p1+1) s2 (p2+1) (len-1)
else true
let rec contains_string s1 p1 s2 =
let ls1 = length s1 in
let ls2 = length s2 in
try let pos = index_from s1 p1 s2.[0] in
if ls1 - pos < ls2 then None
else if eq_sub_strings s1 pos s2 0 ls2 then
Some pos else contains_string s1 (pos + 1) s2
with Not_found -> None
let subst patt repl s =
let lpatt = length patt in
let lrepl = length repl in
let rec loop s from =
match contains_string s from patt with
| Some pos ->
loop (before s pos ^ repl ^ after s (pos + lpatt)) (pos + lrepl)
| None -> s
in loop s 0
let tr patt subst text =
String.map (fun c -> if c = patt then subst else c) text
(*** is_prefix : is u a prefix of v ? *)
let is_prefix u v =
let m = String.length u
and n = String.length v
in
m <= n &&
let rec loop i = i = m || u.[i] = v.[i] && loop (i + 1) in
loop 0
(* ***)
(*** is_suffix : is v a suffix of u ? *)
let is_suffix u v =
let m = String.length u
and n = String.length v
in
n <= m &&
let rec loop i = i = n || u.[m - 1 - i] = v.[n - 1 - i] && loop (i + 1) in
loop 0
(* ***)
let rev s =
let sl = String.length s in
let s' = Bytes.create sl in
for i = 0 to sl - 1 do
Bytes.set s' i s.[sl - i - 1]
done;
Bytes.to_string s';;
let implode l =
match l with
| [] -> ""
| cs ->
let r = Bytes.create (List.length cs) in
let pos = ref 0 in
List.iter begin fun c ->
Bytes.unsafe_set r !pos c;
incr pos
end cs;
Bytes.to_string r
let explode s =
let sl = String.length s in
let rec go pos =
if pos >= sl then [] else unsafe_get s pos :: go (pos + 1)
in go 0
end
module StringSet = Set.Make(String)
let sys_readdir, reset_readdir_cache, reset_readdir_cache_for =
let cache = Hashtbl.create 103 in
let sys_readdir dir =
try Hashtbl.find cache dir with Not_found ->
let res = Outcome.wrap Sys.readdir dir in
(Hashtbl.add cache dir res; res)
and reset_readdir_cache () =
Hashtbl.clear cache
and reset_readdir_cache_for dir =
Hashtbl.remove cache dir in
(sys_readdir, reset_readdir_cache, reset_readdir_cache_for)
let sys_file_exists x =
let dirname = Filename.dirname x in
let basename = Filename.basename x in
match sys_readdir dirname with
| Outcome.Bad _ -> false
| Outcome.Good a ->
if basename = Filename.current_dir_name then true else
try Array.iter (fun x -> if x = basename then raise Exit) a; false
with Exit -> true
let sys_command =
match Sys.os_type with
| "Win32" -> fun cmd ->
if cmd = "" then 0 else
let cmd = "bash --norc -c "^Filename.quote cmd in
Sys.command cmd
| _ -> fun cmd -> if cmd = "" then 0 else Sys.command cmd
(* FIXME warning fix and use Filename.concat *)
let filename_concat x y =
if x = Filename.current_dir_name || x = "" then y else
if Sys.os_type = "Win32" && (x.[String.length x - 1] = '\\') || x.[String.length x - 1] = '/' then
if y = "" then x
else x ^ y
else
x ^ "/" ^ y
(* let reslash =
match Sys.os_type with
| "Win32" -> tr '\\' '/'
| _ -> (fun x -> x) *)
open Format
let invalid_arg' fmt = ksbprintf invalid_arg fmt
let the = function Some x -> x | None -> invalid_arg "the: expect Some not None"
let getenv ?default var =
try Sys.getenv var
with Not_found ->
match default with
| Some x -> x
| None -> failwith (sprintf "This command must have %S in his environment" var);;
let with_input_file ?(bin=false) x f =
let ic = (if bin then open_in_bin else open_in) x in
try let res = f ic in close_in ic; res with e -> (close_in ic; raise e)
let with_output_file ?(bin=false) x f =
reset_readdir_cache_for (Filename.dirname x);
let oc = (if bin then open_out_bin else open_out) x in
try let res = f oc in close_out oc; res with e -> (close_out oc; raise e)
let read_file x =
with_input_file ~bin:true x begin fun ic ->
let len = in_channel_length ic in
really_input_string ic len
end
let copy_chan ic oc =
let m = in_channel_length ic in
let m = (m lsr 12) lsl 12 in
let m = max 16384 (min Sys.max_string_length m) in
let buf = Bytes.create m in
let rec loop () =
let len = input ic buf 0 m in
if len > 0 then begin
output oc buf 0 len;
loop ()
end
in loop ()
let copy_file src dest =
reset_readdir_cache_for (Filename.dirname dest);
with_input_file ~bin:true src begin fun ic ->
with_output_file ~bin:true dest begin fun oc ->
copy_chan ic oc
end
end
let ( !* ) = Lazy.force
let ( @:= ) ref list = ref := !ref @ list
let ( & ) f x = f x
let ( |> ) x f = f x
let print_string_list = List.print String.print
module Digest = struct
include Digest
(* USEFUL FOR DIGEST DEBUGING
let digest_log_hash = Hashtbl.create 103;;
let digest_log = "digest.log";;
let digest_log_oc = open_out_gen [Open_append;Open_wronly;Open_text;Open_creat] 0o666 digest_log;;
let my_to_hex x = to_hex x ^ ";";;
if sys_file_exists digest_log then
with_input_file digest_log begin fun ic ->
try while true do
let l = input_line ic in
Scanf.sscanf l "%S: %S" (Hashtbl.replace digest_log_hash)
done with End_of_file -> ()
end;;
let string s =
let res = my_to_hex (string s) in
if try let x = Hashtbl.find digest_log_hash res in s <> x with Not_found -> true then begin
Hashtbl.replace digest_log_hash res s;
Printf.fprintf digest_log_oc "%S: %S\n%!" res s
end;
res
let file f = my_to_hex (file f)
let to_hex x = x
*)
let digest_cache = Hashtbl.create 103
let reset_digest_cache () = Hashtbl.clear digest_cache
let reset_digest_cache_for file = Hashtbl.remove digest_cache file
let file f =
try Hashtbl.find digest_cache f
with Not_found ->
let res = file f in
(Hashtbl.add digest_cache f res; res)
end
let reset_filesys_cache () =
Digest.reset_digest_cache ();
reset_readdir_cache ()
let reset_filesys_cache_for_file file =
Digest.reset_digest_cache_for file;
reset_readdir_cache_for (Filename.dirname file)
let sys_remove x =
reset_filesys_cache_for_file x;
Sys.remove x
let with_temp_file pre suf fct =
let tmp = Filename.temp_file pre suf in
(* Sys.remove is used instead of sys_remove since we know that the tempfile is not that important *)
try let res = fct tmp in Sys.remove tmp; res
with e -> (Sys.remove tmp; raise e)
let memo f =
let cache = Hashtbl.create 103 in
fun x ->
try Hashtbl.find cache x
with Not_found ->
let res = f x in
(Hashtbl.add cache x res; res)
let memo2 f =
let cache = Hashtbl.create 103 in
fun x y ->
try Hashtbl.find cache (x,y)
with Not_found ->
let res = f x y in
(Hashtbl.add cache (x,y) res; res)
let memo3 f =
let cache = Hashtbl.create 103 in
fun x y z ->
try Hashtbl.find cache (x,y,z)
with Not_found ->
let res = f x y z in
(Hashtbl.add cache (x,y,z) res; res)
let set_lexbuf_fname fname lexbuf =
let open Lexing in
lexbuf.lex_start_p <- { lexbuf.lex_start_p with pos_fname = fname };
lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = fname };
()
let lexbuf_of_string ?name content =
let lexbuf = Lexing.from_string content in
let fname = match name with
| Some name -> name
| None ->
(* 40: hope the location will fit one line of 80 chars *)
if String.length content < 40 && not (String.contains content '\n') then
String.escaped content
else ""
in
set_lexbuf_fname fname lexbuf;
lexbuf

68
ocamlbuild/my_std.mli
View File

@ -1,68 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(* My_std *)
(** Generic utility functions, and system-independent glue. *)
exception Exit_OK
exception Exit_usage of string
exception Exit_system_error of string
exception Exit_with_code of int
exception Exit_silently_with_code of int
module Outcome : Signatures.OUTCOME
val ksbprintf : (string -> 'a) -> ('b, Format.formatter, unit, 'a) format4 -> 'b
val sbprintf : ('a, Format.formatter, unit, string) format4 -> 'a
module Set : sig
module type OrderedTypePrintable = Signatures.OrderedTypePrintable
module type S = Signatures.SET
module Make (M : OrderedTypePrintable) : S with type elt = M.t
end
module List : Signatures.LIST
module String : Signatures.STRING
module Digest : sig
type t = string
val string : string -> t
val substring : string -> int -> int -> t
external channel : in_channel -> int -> t = "caml_md5_chan"
val file : string -> t
val output : out_channel -> t -> unit
val input : in_channel -> t
val to_hex : t -> string
end
module StringSet : Set.S with type elt = String.t
val sys_readdir : string -> (string array, exn) Outcome.t
val sys_remove : string -> unit
val reset_readdir_cache : unit -> unit
val reset_filesys_cache : unit -> unit
val reset_filesys_cache_for_file : string -> unit
val sys_file_exists : string -> bool
val sys_command : string -> int
val filename_concat : string -> string -> string
val invalid_arg' : ('a, Format.formatter, unit, 'b) format4 -> 'a
include Signatures.MISC
val set_lexbuf_fname : string -> Lexing.lexbuf -> unit
val lexbuf_of_string : ?name:string -> string -> Lexing.lexbuf

147
ocamlbuild/my_unix.ml
View File

@ -1,147 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
type file_kind =
| FK_dir
| FK_file
| FK_link
| FK_other
type stats =
{
stat_file_kind : file_kind;
stat_key : string
}
type implem =
{
mutable is_degraded : bool;
mutable is_link : string -> bool;
mutable run_and_open : 'a . string -> (in_channel -> 'a) -> 'a;
mutable readlink : string -> string;
mutable execute_many : ?max_jobs:int ->
?ticker:(unit -> unit) ->
?period:float ->
?display:((out_channel -> unit) -> unit) ->
((unit -> string) list list) ->
(bool list * exn) option;
mutable report_error : Format.formatter -> exn -> unit;
mutable at_exit_once : (unit -> unit) -> unit;
mutable gettimeofday : unit -> float;
mutable stdout_isatty : unit -> bool;
mutable stat : string -> stats;
mutable lstat : string -> stats;
}
let is_degraded = true
let stat f =
{ stat_key = f;
stat_file_kind =
if sys_file_exists f then
if Sys.is_directory f then
FK_dir
else
FK_file
else let _ = with_input_file f input_char in assert false }
let run_and_open s kont =
with_temp_file "ocamlbuild" "out" begin fun tmp ->
let s = Printf.sprintf "%s > '%s'" s tmp in
let st = sys_command s in
if st <> 0 then failwith (Printf.sprintf "Error while running: %s" s);
with_input_file tmp kont
end
exception Not_a_link
exception No_such_file
exception Link_to_directories_not_supported
let readlinkcmd =
let cache = Hashtbl.create 32 in
fun x ->
try Hashtbl.find cache x
with Not_found ->
run_and_open (Printf.sprintf "readlink %s" (Filename.quote x)) begin fun ic ->
let y = String.chomp (input_line ic) in
Hashtbl.replace cache x y; y
end
let rec readlink x =
if sys_file_exists x then
try
let y = readlinkcmd x in
let y =
if Filename.is_relative y then
Filename.concat (Filename.dirname x) y
else
y
in
if (lstat y).stat_file_kind = FK_dir then raise Link_to_directories_not_supported else y
with Failure(_) -> raise Not_a_link
else raise No_such_file
and is_link x =
try ignore(readlink x); true with
| No_such_file | Not_a_link -> false
and lstat x =
if is_link x then { stat_key = x; stat_file_kind = FK_link } else stat x
let implem =
{
is_degraded = true;
stat = stat;
lstat = lstat;
readlink = readlink;
is_link = is_link;
run_and_open = run_and_open;
(* at_exit_once is at_exit in the degraded mode since fork is not accessible in this mode *)
at_exit_once = at_exit;
report_error = (fun _ -> raise);
gettimeofday = (fun () -> assert false);
stdout_isatty = (fun () -> false);
execute_many = (fun ?max_jobs:(_) ?ticker:(_) ?period:(_) ?display:(_) _ -> assert false)
}
let is_degraded = lazy implem.is_degraded
let stat x = implem.stat x
let lstat x = implem.lstat x
let readlink x = implem.readlink x
let is_link x = implem.is_link x
let run_and_open x = implem.run_and_open x
let at_exit_once x = implem.at_exit_once x
let report_error x = implem.report_error x
let gettimeofday x = implem.gettimeofday x
let stdout_isatty x = implem.stdout_isatty x
let execute_many ?max_jobs = implem.execute_many ?max_jobs
let run_and_read cmd =
let bufsiz = 2048 in
let buf = Bytes.create bufsiz in
let totalbuf = Buffer.create 4096 in
implem.run_and_open cmd begin fun ic ->
let rec loop pos =
let len = input ic buf 0 bufsiz in
if len > 0 then begin
Buffer.add_subbytes totalbuf buf 0 len;
loop (pos + len)
end
in loop 0; Buffer.contents totalbuf
end

75
ocamlbuild/my_unix.mli
View File

@ -1,75 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
type file_kind =
| FK_dir
| FK_file
| FK_link
| FK_other
type stats =
{
stat_file_kind : file_kind;
stat_key : string
}
val is_degraded : bool Lazy.t
val is_link : string -> bool
val run_and_open : string -> (in_channel -> 'a) -> 'a
val readlink : string -> string
val run_and_read : string -> string
(** See [Ocamlbuild_executor.execute] *)
val execute_many :
?max_jobs:int ->
?ticker:(unit -> unit) ->
?period:float ->
?display:((out_channel -> unit) -> unit) ->
((unit -> string) list list) ->
(bool list * exn) option
val report_error : Format.formatter -> exn -> unit
val at_exit_once : (unit -> unit) -> unit
val gettimeofday : unit -> float
val stdout_isatty : unit -> bool
val stat : string -> stats
val lstat : string -> stats
(** internal usage only *)
type implem =
{
mutable is_degraded : bool;
mutable is_link : string -> bool;
mutable run_and_open : 'a . string -> (in_channel -> 'a) -> 'a;
mutable readlink : string -> string;
mutable execute_many : ?max_jobs:int ->
?ticker:(unit -> unit) ->
?period:float ->
?display:((out_channel -> unit) -> unit) ->
((unit -> string) list list) ->
(bool list * exn) option;
mutable report_error : Format.formatter -> exn -> unit;
mutable at_exit_once : (unit -> unit) -> unit;
mutable gettimeofday : unit -> float;
mutable stdout_isatty : unit -> bool;
mutable stat : string -> stats;
mutable lstat : string -> stats;
}
val implem : implem

137
ocamlbuild/ocaml_arch.ml
View File

@ -1,137 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
open Command
open Pathname.Operators
type 'a arch =
| Arch_dir of string * 'a * 'a arch list
| Arch_dir_pack of string * 'a * 'a arch list
| Arch_file of string * 'a
let dir name contents = Arch_dir(name, (), contents)
let dir_pack name contents = Arch_dir_pack(name, (), contents)
let file name = Arch_file(name, ())
type info =
{
current_path : string;
include_dirs : string list;
for_pack : string;
}
let join_pack parent base =
if parent = "" then base else parent ^ "." ^ base
let annotate arch =
let rec self arch acc =
match arch with
| Arch_dir_pack(name, _, contents) ->
let acc = { (acc) with for_pack = join_pack acc.for_pack name } in
let (_, _, i, new_contents) = self_contents name contents acc in
([], Arch_dir_pack(name, i, List.rev new_contents))
| Arch_dir(name, _, contents) ->
let (current_path, include_dirs, i, new_contents) = self_contents name contents acc in
(current_path :: include_dirs, Arch_dir(name, i, List.rev new_contents))
| Arch_file(name, _) ->
([], Arch_file(name, acc))
and self_contents name contents acc =
let current_path = acc.current_path/name in
let include_dirs = if current_path = "" then acc.include_dirs else current_path :: acc.include_dirs in
let i = { (acc) with current_path = current_path; include_dirs = include_dirs } in
let (include_dirs, new_contents) =
List.fold_left begin fun (include_dirs, new_contents) x ->
let j = { (i) with include_dirs = include_dirs @ i.include_dirs } in
let (include_dirs', x') = self x j in
(include_dirs @ include_dirs', x' :: new_contents)
end ([], []) contents in
(current_path, include_dirs, i, new_contents) in
let init = { current_path = ""; include_dirs = []; for_pack = "" } in
snd (self arch init)
let rec print print_info f =
let rec print_contents f =
function
| [] -> ()
| x :: xs -> Format.fprintf f "@ %a%a" (print print_info) x print_contents xs in
function
| Arch_dir(name, info, contents) ->
Format.fprintf f "@[<v2>dir %S%a%a@]" name print_info info print_contents contents
| Arch_dir_pack(name, info, contents) ->
Format.fprintf f "@[<v2>dir_pack %S%a%a@]" name print_info info print_contents contents
| Arch_file(name, info) ->
Format.fprintf f "@[<2>file %S%a@]" name print_info info
let print_include_dirs = List.print String.print
let print_info f i =
Format.fprintf f "@ @[<v2>{ @[<2>current_path =@ %S@];@\
\ @[<2>include_dirs =@ %a@];@\
\ @[<2>for_pack =@ %S@] }@]"
i.current_path print_include_dirs i.include_dirs i.for_pack
let rec iter_info f =
function
| Arch_dir_pack(_, i, xs) | Arch_dir(_, i, xs) ->
f i; List.iter (iter_info f) xs
| Arch_file(_, i) -> f i
let rec fold_info f arch acc =
match arch with
| Arch_dir_pack(_, i, xs) | Arch_dir(_, i, xs) ->
List.fold_right (fold_info f) xs (f i acc)
| Arch_file(_, i) -> f i acc
module SS = Set.Make(String)
let iter_include_dirs arch =
let set = fold_info (fun i -> List.fold_right SS.add i.include_dirs) arch SS.empty in
fun f -> SS.iter f set
let forpack_flags_of_pathname = ref (fun _ -> N)
let print_table print_value f table =
Format.fprintf f "@[<hv0>{:@[<hv0>";
Hashtbl.iter begin fun k v ->
if k <> "" then
Format.fprintf f "@ @[<2>%S =>@ %a@];" k print_value v;
end table;
Format.fprintf f "@]@ :}@]"
let print_tables f (include_dirs_table, for_pack_table) =
Format.fprintf f "@[<2>@[<2>include_dirs_table:@ %a@];@ @[<2>for_pack_table: %a@]@]"
(print_table (List.print String.print)) include_dirs_table
(print_table String.print) for_pack_table
let mk_tables arch =
let include_dirs_table = Hashtbl.create 17
and for_pack_table = Hashtbl.create 17 in
iter_info begin fun i ->
Hashtbl.replace include_dirs_table i.current_path i.include_dirs;
Hashtbl.replace for_pack_table i.current_path i.for_pack
end arch;
let previous_forpack_flags_of_pathname = !forpack_flags_of_pathname in
forpack_flags_of_pathname := begin fun m ->
let m' = Pathname.dirname m in
try
let for_pack = Hashtbl.find for_pack_table m' in
if for_pack = "" then N else S[A"-for-pack"; A for_pack]
with Not_found -> previous_forpack_flags_of_pathname m
end;
(* Format.eprintf "@[<2>%a@]@." print_tables (include_dirs_table, for_pack_table); *)
(include_dirs_table, for_pack_table)
let forpack_flags_of_pathname m = !forpack_flags_of_pathname m

18
ocamlbuild/ocaml_arch.mli
View File

@ -1,18 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
include Signatures.ARCH
val forpack_flags_of_pathname : string -> Command.spec

433
ocamlbuild/ocaml_compiler.ml
View File

@ -1,433 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
open Format
open Log
open Pathname.Operators
open Tools
open Command
open Rule
open Tags.Operators
open Ocaml_utils
open Rule.Common_commands
open Outcome
let forpack_flags arg tags =
if Tags.mem "pack" tags then
Ocaml_arch.forpack_flags_of_pathname arg
else N
let ocamlc_c tags arg out =
let tags = tags++"ocaml"++"byte" in
Cmd (S [!Options.ocamlc; A"-c"; T(tags++"compile");
ocaml_ppflags tags; ocaml_include_flags arg; A"-o"; Px out; P arg])
let ocamlc_link flag tags deps out =
Cmd (S [!Options.ocamlc; flag; T tags;
atomize_paths deps; A"-o"; Px out])
let ocamlc_link_lib = ocamlc_link (A"-a")
let ocamlc_link_prog = ocamlc_link N
let ocamlmklib tags deps out =
Cmd (S [!Options.ocamlmklib; T tags;
atomize_paths deps; A"-o"; Px (Pathname.remove_extensions out)])
let ocamlmktop tags deps out =
Cmd( S [!Options.ocamlmktop; T (tags++"mktop");
atomize_paths deps; A"-o"; Px out])
let byte_lib_linker tags =
if Tags.mem "ocamlmklib" tags then
ocamlmklib tags
else
ocamlc_link_lib tags
let byte_lib_linker_tags tags = tags++"ocaml"++"link"++"byte"++"library"
let ocamlc_p tags deps out =
Cmd (S [!Options.ocamlc; A"-pack"; T tags;
atomize_paths deps; A"-o"; Px out])
let ocamlopt_c tags arg out =
let tags = tags++"ocaml"++"native" in
Cmd (S [!Options.ocamlopt; A"-c"; Ocaml_arch.forpack_flags_of_pathname arg;
T(tags++"compile"); ocaml_ppflags tags; ocaml_include_flags arg;
A"-o"; Px out (* FIXME ocamlopt bug -o cannot be after the input file *); P arg])
let ocamlopt_link flag tags deps out =
Cmd (S [!Options.ocamlopt; flag; forpack_flags out tags; T tags;
atomize_paths deps; A"-o"; Px out])
let ocamlopt_link_lib = ocamlopt_link (A"-a")
let ocamlopt_link_shared_lib = ocamlopt_link (A"-shared")
let ocamlopt_link_prog = ocamlopt_link N
let ocamlopt_p tags deps out =
let dirnames = List.union [] (List.map Pathname.dirname deps) in
let include_flags = List.fold_right ocaml_add_include_flag dirnames [] in
let mli = Pathname.update_extensions "mli" out in
let cmd =
S [!Options.ocamlopt; A"-pack"; forpack_flags out tags; T tags;
S include_flags; atomize_paths deps;
A"-o"; Px out] in
if (*FIXME true ||*) Pathname.exists mli then Cmd cmd
else
let rm = S[A"rm"; A"-f"; P mli] in
Cmd(S[A"touch"; P mli; Sh" ; if "; cmd; Sh" ; then "; rm; Sh" ; else ";
rm; Sh" ; exit 1; fi"])
let native_lib_linker tags =
if Tags.mem "ocamlmklib" tags then
ocamlmklib tags
else
ocamlopt_link_lib tags
let native_shared_lib_linker tags =
(* ocamlmklib seems to not support -shared, is this OK?
if Tags.mem "ocamlmklib" tags then
ocamlmklib tags
else
*)
ocamlopt_link_shared_lib tags
let native_lib_linker_tags tags = tags++"ocaml"++"link"++"native"++"library"
let prepare_compile build ml =
let dir = Pathname.dirname ml in
let include_dirs = Pathname.include_dirs_of dir in
let modules = path_dependencies_of ml in
let results =
build (List.map (fun (_, x) -> expand_module include_dirs x ["cmi"]) modules) in
List.iter2 begin fun (mandatory, name) res ->
match mandatory, res with
| _, Good _ -> ()
| `mandatory, Bad exn ->
if not !Options.ignore_auto then raise exn;
dprintf 3
"Warning: Failed to build the module %s requested by ocamldep."
name;
if not (!Options.recursive || Options.ocamlbuild_project_heuristic ())
then Log.at_failure ~name:"a module failed to build,
while recursive traversal was disabled by fragile heuristic;
hint that having a _tags or myocamlbuild.ml would maybe solve
the build error"
(fun `Error ->
eprintf "Hint:@ Recursive@ traversal@ of@ subdirectories@ \
was@ not@ enabled@ for@ this@ build,@ as@ the@ working@ \
directory does@ not@ look@ like@ an@ ocamlbuild@ project@ \
(no@ '_tags'@ or@ 'myocamlbuild.ml'@ file).@ \
If@ you@ have@ modules@ in@ subdirectories,@ you@ should@ add@ \
the@ option@ \"-r\"@ or@ create@ an@ empty@ '_tags'@ file.@\n\
@\n\
To@ enable@ recursive@ traversal@ for@ some@ subdirectories@ \
only,@ you@ can@ use@ the@ following@ '_tags'@ file:@\n\
@[<v 4>@,\
true: -traverse@,\
<dir1> or <dir2>: traverse@,\
@]"
);
| `just_try, Bad _ -> ()
end modules results
let byte_compile_ocaml_interf mli cmi env build =
let mli = env mli and cmi = env cmi in
prepare_compile build mli;
ocamlc_c (tags_of_pathname mli++"interf") mli cmi
(* given that .cmi can be built from either ocamlc and ocamlopt, this
"agnostic" rule chooses either compilers depending on whether the
"native" tag is present. This was requested during PR#4613 as way
to enable using ocamlbuild in environments where only ocamlopt is
available, not ocamlc. *)
let compile_ocaml_interf mli cmi env build =
let mli = env mli and cmi = env cmi in
prepare_compile build mli;
let tags = tags_of_pathname mli++"interf" in
let comp_c = if Tags.mem "native" tags then ocamlopt_c else ocamlc_c in
comp_c tags mli cmi
let byte_compile_ocaml_implem ?tag ml cmo env build =
let ml = env ml and cmo = env cmo in
prepare_compile build ml;
ocamlc_c (Tags.union (tags_of_pathname ml) (tags_of_pathname cmo)++"implem"+++tag) ml cmo
let cache_prepare_link = Hashtbl.create 107
let rec prepare_link tag cmx extensions build =
let key = (tag, cmx, extensions) in
let dir = Pathname.dirname cmx in
let include_dirs = Pathname.include_dirs_of dir in
let ml = Pathname.update_extensions "ml" cmx in
let mli = Pathname.update_extensions "mli" cmx in
let modules =
List.union
(if Pathname.exists (ml-.-"depends") then path_dependencies_of ml else [])
(if Pathname.exists (mli-.-"depends") then path_dependencies_of mli else [])
in
let modules =
if (modules = []) && (Pathname.exists (ml^"pack")) then
List.map (fun s -> (`mandatory, s)) (string_list_of_file (ml^"pack"))
else
modules
in
if modules <> [] && not (Hashtbl.mem cache_prepare_link key) then
let () = Hashtbl.add cache_prepare_link key true in
let modules' = List.map (fun (_, x) -> expand_module include_dirs x extensions) modules in
List.iter2 begin fun (mandatory, _) result ->
match mandatory, result with
| _, Good p -> prepare_link tag p extensions build
| `mandatory, Bad exn -> if not !Options.ignore_auto then raise exn
| `just_try, Bad _ -> ()
end modules (build modules')
let native_compile_ocaml_implem ?tag ?(cmx_ext="cmx") ml env build =
let ml = env ml in
let cmi = Pathname.update_extensions "cmi" ml in
let cmx = Pathname.update_extensions cmx_ext ml in
prepare_link cmx cmi [cmx_ext; "cmi"] build;
ocamlopt_c (Tags.union (tags_of_pathname ml) (tags_of_pathname cmx)++"implem"+++tag) ml cmx
let libs_of_use_lib tags =
Tags.fold begin fun tag acc ->
try let libpath, extern = Hashtbl.find info_libraries tag in
if extern then acc else libpath :: acc
with Not_found -> acc
end tags []
let prepare_libs cma_ext a_ext out build =
let out_no_ext = Pathname.remove_extension out in
let libs1 = List.union (libraries_of out_no_ext) (libs_of_use_lib (tags_of_pathname out)) in
let () = dprintf 10 "prepare_libs: %S -> %a" out pp_l libs1 in
let libs = List.map (fun x -> x-.-cma_ext) libs1 in
let libs2 = List.map (fun lib -> [lib-.-a_ext]) libs1 in
List.iter ignore_good (build libs2); libs
let library_index = Hashtbl.create 32
let package_index = Hashtbl.create 32
let hidden_packages = ref []
let hide_package_contents package = hidden_packages := package :: !hidden_packages
module Ocaml_dependencies_input = struct
let fold_dependencies = Resource.Cache.fold_dependencies
let fold_libraries f = Hashtbl.fold f library_index
let fold_packages f = Hashtbl.fold f package_index
end
module Ocaml_dependencies = Ocaml_dependencies.Make(Ocaml_dependencies_input)
let caml_transitive_closure = Ocaml_dependencies.caml_transitive_closure
let link_one_gen linker tagger cmX out env _build =
let cmX = env cmX and out = env out in
let tags = tagger (tags_of_pathname out) in
linker tags [cmX] out
let link_gen cmX_ext cma_ext a_ext extensions linker tagger cmX out env build =
let cmX = env cmX and out = env out in
let tags = tagger (tags_of_pathname out) in
let dyndeps = Rule.build_deps_of_tags build (tags++"link_with") in
let cmi = Pathname.update_extensions "cmi" cmX in
prepare_link cmX cmi extensions build;
let libs = prepare_libs cma_ext a_ext out build in
let hidden_packages = List.map (fun x -> x-.-cmX_ext) !hidden_packages in
let deps =
caml_transitive_closure
~caml_obj_ext:cmX_ext ~caml_lib_ext:cma_ext
~used_libraries:libs ~hidden_packages (cmX :: dyndeps) in
let deps = (List.filter (fun l -> not (List.mem l deps)) libs) @ deps in
(* Hack to avoid linking twice with the standard library. *)
let stdlib = "stdlib/stdlib"-.-cma_ext in
let is_not_stdlib x = x <> stdlib in
let deps = List.filter is_not_stdlib deps in
if deps = [] then failwith "Link list cannot be empty";
let () = dprintf 6 "link: %a -o %a" print_string_list deps Pathname.print out in
linker (tags++"dont_link_with") deps out
let byte_link_gen = link_gen "cmo" "cma" "cma" ["cmo"; "cmi"]
let byte_link = byte_link_gen ocamlc_link_prog
(fun tags -> tags++"ocaml"++"link"++"byte"++"program")
let byte_output_obj = byte_link_gen ocamlc_link_prog
(fun tags -> tags++"ocaml"++"link"++"byte"++"output_obj")
let byte_output_shared = byte_link_gen ocamlc_link_prog
(fun tags -> tags++"ocaml"++"link"++"byte"++"output_obj"++"output_shared")
let byte_library_link = byte_link_gen byte_lib_linker byte_lib_linker_tags
let byte_debug_link_gen =
link_gen "d.cmo" "d.cma" "d.cma" ["d.cmo"; "cmi"]
let byte_debug_link = byte_debug_link_gen ocamlc_link_prog
(fun tags -> tags++"ocaml"++"link"++"byte"++"debug"++"program")
let byte_debug_library_link = byte_debug_link_gen byte_lib_linker
(fun tags -> byte_lib_linker_tags tags++"debug")
let native_link_gen linker =
link_gen "cmx" "cmxa" !Options.ext_lib [!Options.ext_obj; "cmi"] linker
let native_link x = native_link_gen ocamlopt_link_prog
(fun tags -> tags++"ocaml"++"link"++"native"++"program") x
let native_output_obj x = native_link_gen ocamlopt_link_prog
(fun tags -> tags++"ocaml"++"link"++"native"++"output_obj") x
let native_output_shared x = native_link_gen ocamlopt_link_prog
(fun tags -> tags++"ocaml"++"link"++"native"++"output_obj"++"output_shared") x
let native_library_link x =
native_link_gen native_lib_linker native_lib_linker_tags x
let native_profile_link_gen linker =
link_gen "p.cmx" "p.cmxa" ("p" -.- !Options.ext_lib) ["p" -.- !Options.ext_obj; "cmi"] linker
let native_profile_link x = native_profile_link_gen ocamlopt_link_prog
(fun tags -> tags++"ocaml"++"link"++"native"++"profile"++"program") x
let native_profile_library_link x = native_profile_link_gen native_lib_linker
(fun tags -> native_lib_linker_tags tags++"profile") x
let link_units table extensions cmX_ext cma_ext a_ext linker tagger contents_list cmX env build =
let cmX = env cmX in
let tags = tagger (tags_of_pathname cmX) in
let _ = Rule.build_deps_of_tags build tags in
let dir =
let dir1 = Pathname.remove_extensions cmX in
if Resource.exists_in_source_dir dir1 then dir1
else Pathname.dirname cmX in
let include_dirs = Pathname.include_dirs_of dir in
let extension_keys = List.map fst extensions in
let libs = prepare_libs cma_ext a_ext cmX build in
let results =
build begin
List.map begin fun module_name ->
expand_module include_dirs module_name extension_keys
end contents_list
end in
let module_paths =
List.map begin function
| Good p ->
let extension_values = List.assoc (Pathname.get_extensions p) extensions in
List.iter begin fun ext ->
List.iter ignore_good (build [[Pathname.update_extensions ext p]])
end extension_values; p
| Bad exn -> raise exn
end results in
Hashtbl.replace table cmX module_paths;
let hidden_packages = List.map (fun x -> x-.-cmX_ext) !hidden_packages in
let deps =
caml_transitive_closure
~caml_obj_ext:cmX_ext ~caml_lib_ext:cma_ext
~hidden_packages ~pack_mode:true module_paths in
let full_contents = libs @ module_paths in
let deps = List.filter (fun x -> List.mem x full_contents) deps in
let deps = (List.filter (fun l -> not (List.mem l deps)) libs) @ deps in
(* Hack to avoid linking twice with the standard library. *)
let stdlib = "stdlib/stdlib"-.-cma_ext in
let is_not_stdlib x = x <> stdlib in
let deps = List.filter is_not_stdlib deps in
linker tags deps cmX
let link_modules = link_units library_index
let pack_modules = link_units package_index
let link_from_file link modules_file cmX env build =
let modules_file = env modules_file in
let contents_list = string_list_of_file modules_file in
link contents_list cmX env build
let byte_library_link_modules =
link_modules [("cmo",[])] "cmo" "cma" "cma" byte_lib_linker byte_lib_linker_tags
let byte_library_link_mllib = link_from_file byte_library_link_modules
let byte_toplevel_link_modules =
link_modules [("cmo",[])] "cmo" "cma" "cma" ocamlmktop
(fun tags -> tags++"ocaml"++"link"++"byte"++"toplevel")
let byte_toplevel_link_mltop = link_from_file byte_toplevel_link_modules
let byte_debug_library_link_modules =
link_modules [("d.cmo",[])] "d.cmo" "d.cma" "d.cma" byte_lib_linker
(fun tags -> byte_lib_linker_tags tags++"debug")
let byte_debug_library_link_mllib = link_from_file byte_debug_library_link_modules
let byte_pack_modules =
pack_modules [("cmo",["cmi"]); ("cmi",[])] "cmo" "cma" "cma" ocamlc_p
(fun tags -> tags++"ocaml"++"pack"++"byte")
let byte_pack_mlpack = link_from_file byte_pack_modules
let byte_debug_pack_modules =
pack_modules [("d.cmo",["cmi"]); ("cmi",[])] "d.cmo" "d.cma" "d.cma" ocamlc_p
(fun tags -> tags++"ocaml"++"pack"++"byte"++"debug")
let byte_debug_pack_mlpack = link_from_file byte_debug_pack_modules
let native_pack_modules x =
pack_modules [("cmx",["cmi"; !Options.ext_obj]); ("cmi",[])] "cmx" "cmxa" !Options.ext_lib ocamlopt_p
(fun tags -> tags++"ocaml"++"pack"++"native") x
let native_pack_mlpack = link_from_file native_pack_modules
let native_profile_pack_modules x =
pack_modules [("p.cmx",["cmi"; "p" -.- !Options.ext_obj]); ("cmi",[])] "p.cmx" "p.cmxa"
("p" -.- !Options.ext_lib) ocamlopt_p
(fun tags -> tags++"ocaml"++"pack"++"native"++"profile") x
let native_profile_pack_mlpack = link_from_file native_profile_pack_modules
let native_library_link_modules x =
link_modules [("cmx",[!Options.ext_obj])] "cmx" "cmxa"
!Options.ext_lib native_lib_linker native_lib_linker_tags x
let native_shared_library_link_modules x =
link_modules [("cmx",[!Options.ext_obj])] "cmx" "cmxa"
!Options.ext_lib native_shared_lib_linker
(fun tags -> native_lib_linker_tags tags++"shared") x
let native_library_link_mllib = link_from_file native_library_link_modules
let native_shared_library_link_mldylib = link_from_file native_shared_library_link_modules
let native_shared_library_tags tags basetags =
List.fold_left (++) (basetags++"ocaml"++"link"++"native"++"shared"++"library") tags
let native_shared_library_link ?(tags = []) x =
link_one_gen native_shared_lib_linker
(native_shared_library_tags tags) x
let native_profile_library_link_modules x =
link_modules [("p.cmx",["p" -.- !Options.ext_obj])] "p.cmx" "p.cmxa"
("p" -.- !Options.ext_lib) native_lib_linker
(fun tags -> native_lib_linker_tags tags++"profile") x
let native_profile_shared_library_link_modules x =
link_modules [("p.cmx",["p" -.- !Options.ext_obj])] "p.cmx" "p.cmxa"
("p" -.- !Options.ext_lib) native_shared_lib_linker
(fun tags -> native_lib_linker_tags tags++"shared"++"profile") x
let native_profile_library_link_mllib = link_from_file native_profile_library_link_modules
let native_profile_shared_library_link_mldylib = link_from_file native_profile_shared_library_link_modules

97
ocamlbuild/ocaml_compiler.mli
View File

@ -1,97 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val forpack_flags : string -> Tags.t -> Command.spec
val ocamlc_c : Tags.t -> Pathname.t -> Pathname.t -> Command.t
val ocamlc_link_lib : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val ocamlc_link_prog : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val ocamlc_p : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val ocamlopt_c : Tags.t -> Pathname.t -> Pathname.t -> Command.t
val ocamlopt_link_lib : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val ocamlopt_link_shared_lib : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val ocamlopt_link_prog : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val ocamlopt_p : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val ocamlmklib : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val ocamlmktop : Tags.t -> Pathname.t list -> Pathname.t -> Command.t
val prepare_compile : Rule.builder -> Pathname.t -> unit
val compile_ocaml_interf : string -> string -> Rule.action
val byte_compile_ocaml_interf : string -> string -> Rule.action
val byte_compile_ocaml_implem : ?tag:string -> string -> string -> Rule.action
val prepare_link :
Pathname.t -> Pathname.t ->
string list -> Rule.builder -> unit
val native_compile_ocaml_implem : ?tag:string -> ?cmx_ext:string -> string -> Rule.action
val prepare_libs :
string -> string -> Pathname.t ->
Rule.builder -> Pathname.t list
val link_gen :
string -> string -> string -> string list ->
(Tags.t -> Pathname.t list -> Pathname.t -> Command.t) ->
(Tags.t -> Tags.t) ->
string -> string -> Rule.action
val byte_link : string -> string -> Rule.action
val byte_output_obj : string -> string -> Rule.action
val byte_output_shared : string -> string -> Rule.action
val byte_library_link : string -> string -> Rule.action
val byte_debug_link : string -> string -> Rule.action
val byte_debug_library_link : string -> string -> Rule.action
val native_link : string -> string -> Rule.action
val native_output_obj : string -> string -> Rule.action
val native_output_shared : string -> string -> Rule.action
val native_library_link : string -> string -> Rule.action
val native_shared_library_link : ?tags:(string list) -> string -> string -> Rule.action
val native_profile_link : string -> string -> Rule.action
val native_profile_library_link : string -> string -> Rule.action
val link_modules :
(Pathname.t * string list) list ->
string -> string ->
string -> (Tags.t -> Pathname.t list -> Pathname.t -> Command.t) ->
(Tags.t -> Tags.t) ->
string list -> string -> Rule.action
val pack_modules :
(Pathname.t * string list) list ->
string -> string ->
string -> (Tags.t -> Pathname.t list -> Pathname.t -> Command.t) ->
(Tags.t -> Tags.t) ->
string list -> string -> Rule.action
val byte_library_link_modules : string list -> string -> Rule.action
val byte_library_link_mllib : string -> string -> Rule.action
val byte_debug_library_link_modules : string list -> string -> Rule.action
val byte_debug_library_link_mllib : string -> string -> Rule.action
val byte_pack_modules : string list -> string -> Rule.action
val byte_pack_mlpack : string -> string -> Rule.action
val byte_debug_pack_modules : string list -> string -> Rule.action
val byte_debug_pack_mlpack : string -> string -> Rule.action
val byte_toplevel_link_modules : string list -> string -> Rule.action
val byte_toplevel_link_mltop : string -> string -> Rule.action
val native_pack_modules : string list -> string -> Rule.action
val native_pack_mlpack : string -> string -> Rule.action
val native_library_link_modules : string list -> string -> Rule.action
val native_library_link_mllib : string -> string -> Rule.action
val native_shared_library_link_modules : string list -> string -> Rule.action
val native_shared_library_link_mldylib : string -> string -> Rule.action
val native_profile_pack_modules : string list -> string -> Rule.action
val native_profile_pack_mlpack : string -> string -> Rule.action
val native_profile_library_link_modules : string list -> string -> Rule.action
val native_profile_library_link_mllib : string -> string -> Rule.action
val native_profile_shared_library_link_modules : string list -> string -> Rule.action
val native_profile_shared_library_link_mldylib : string -> string -> Rule.action
(** [hide_package_contents pack_name]
Don't treat the given package as an open package.
So a module will not be replaced during linking by
this package even if it contains that module. *)
val hide_package_contents : string -> unit

263
ocamlbuild/ocaml_dependencies.ml
View File

@ -1,263 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
open Log
open Tools
open Ocaml_utils
let mydprintf fmt = dprintf 10 fmt
exception Circular_dependencies of string list * string
module type INPUT = sig
val fold_dependencies : (string -> string -> 'a -> 'a) -> 'a -> 'a
val fold_libraries : (string -> string list -> 'a -> 'a) -> 'a -> 'a
val fold_packages : (string -> string list -> 'a -> 'a) -> 'a -> 'a
end
module Make (I : INPUT) = struct
open I
module SMap = Map.Make(String)
module Resources = Resource.Resources
module Utils = struct
let add = SMap.add
let empty = SMap.empty
let find_all_set x acc =
try SMap.find x acc with Not_found -> Resources.empty
let smap_add_set src dst acc =
SMap.add src (Resources.add dst (find_all_set src acc)) acc
let print_smap pp f smap =
Format.fprintf f "@[<hv0>{:@[<hv2>";
SMap.iter begin fun k v ->
Format.fprintf f "@ @[<2>%S =>@ %a@];" k pp v
end smap;
Format.fprintf f "@]@,:}@]"
let print_smap_list = print_smap pp_l
let print_smap_set = print_smap Resources.print
let print_lazy pp f l = pp f !*l
let find_all_list x acc =
try SMap.find x acc with Not_found -> []
let find_all_rec xs map =
let visited = Hashtbl.create 32 in
let rec self x acc =
try
Hashtbl.find visited x; acc
with Not_found ->
Hashtbl.replace visited x ();
let acc = Resources.add x acc in
try Resources.fold self (SMap.find x map) acc
with Not_found -> acc
in List.fold_right self xs Resources.empty
let mkindex fold filter =
fold begin fun name contents acc ->
if filter name then
List.fold_right begin fun elt acc ->
add elt (name :: (find_all_list elt acc)) acc
end contents acc
else
acc
end empty
end
open Utils
let caml_transitive_closure
?(caml_obj_ext="cmo")
?(caml_lib_ext="cma")
?(pack_mode=false)
?(used_libraries=[])
?(hidden_packages=[]) fns =
let valid_link_exts =
if pack_mode then [caml_obj_ext; "cmi"]
else [caml_obj_ext; caml_lib_ext] in
mydprintf "caml_transitive_closure@ ~caml_obj_ext:%S@ ~pack_mode:%b@ ~used_libraries:%a@ %a"
caml_obj_ext pack_mode pp_l used_libraries pp_l fns;
let packages = fold_packages (fun name _ -> Resources.add name) Resources.empty in
mydprintf "packages:@ %a" Resources.print packages;
let caml_obj_ext_of_cmi x =
if Filename.check_suffix x ".cmi" then
Pathname.update_extensions caml_obj_ext x
else x in
let maybe_caml_obj_ext_of_cmi x =
if pack_mode then
if Filename.check_suffix x ".cmi" then
let caml_obj = Pathname.update_extensions caml_obj_ext x in
if Resource.exists_in_build_dir caml_obj then
caml_obj
else
x
else
x
else
if Filename.check_suffix x ".cmi" then
Pathname.update_extensions caml_obj_ext x
else x in
let not_linkable x =
not (List.exists (Pathname.check_extension x) valid_link_exts) in
let dependency_map =
fold_dependencies begin fun x y acc ->
let x = maybe_caml_obj_ext_of_cmi x
and y = maybe_caml_obj_ext_of_cmi y in
if x = y || not_linkable x || not_linkable y then acc
else smap_add_set x y acc
end SMap.empty in
mydprintf "dependency_map:@ %a" print_smap_set dependency_map;
let used_files = find_all_rec fns dependency_map in
mydprintf "used_files:@ %a" Resources.print used_files;
let open_packages =
Resources.fold begin fun file acc ->
if Resources.mem file packages && not (List.mem file hidden_packages)
then file :: acc else acc
end used_files [] in
mydprintf "open_packages:@ %a" pp_l open_packages;
let index_filter ext list x =
Pathname.check_extension x ext && List.mem x list in
let lib_index =
lazy (mkindex fold_libraries (index_filter caml_lib_ext used_libraries)) in
mydprintf "lib_index:@ %a" (print_lazy print_smap_list) lib_index;
let package_index =
lazy (mkindex fold_packages (index_filter caml_obj_ext open_packages)) in
let rec resolve_packages x =
match find_all_list x !*package_index with
| [] -> x
| [x] -> resolve_packages x
| pkgs ->
failwith (sbprintf "the file %S is included in more than one active open package (%a)"
x pp_l pkgs) in
let libs_of x = find_all_list x !*lib_index in
let lib_of x =
match libs_of x with
| [] -> None
| [lib] -> Some(lib)
| libs ->
failwith (sbprintf "the file %S is included in more than one active library (%a)"
x pp_l libs) in
let convert_dependency src dst acc =
let src = resolve_packages src in
let dst = resolve_packages dst in
let add_if_diff x y = if x = y then acc else smap_add_set x y acc in
match (lib_of src, lib_of dst) with
| None, None -> add_if_diff src dst
| Some(liba), Some(libb) -> add_if_diff liba libb
| Some(lib), None -> add_if_diff lib dst
| None, Some(lib) -> add_if_diff src lib in
let dependencies = lazy begin
SMap.fold begin fun k ->
Resources.fold (convert_dependency k)
end dependency_map empty
end in
mydprintf "dependencies:@ %a" (print_lazy print_smap_set) dependencies;
let dependencies_of x =
try SMap.find x !*dependencies with Not_found -> Resources.empty in
let refine_cycle files starting_file =
(* We are looking for a cycle starting from [fn], included in
[files]; we'll simply use a DFS which builds a path until it
finds a circularity.
Note that if there is at least one cycle going through [fn],
calling [dfs path fn] will return it no matter what [path] is
(it may just not be the shortest possible cycle). This means
that if [dfs path fn] returns [None], [fn] is a dead-end that
should never be explored again.
*)
let dead_ends = ref Resources.empty in
let rec dfs path fn =
let through_dep f = function
| Some _ as cycle -> cycle
| None ->
if List.mem f path
then (* we have found a cycle *)
Some (List.rev path)
else if not (Resources.mem f files)
then
(* the neighbor is not in the set of paths known to have a cycle *)
None
else
(* look for cycles going through this neighbor *)
dfs (f :: path) f
in
if Resources.mem fn !dead_ends then None
else match Resources.fold through_dep (dependencies_of fn) None with
| Some _ as cycle -> cycle
| None -> dead_ends := Resources.add fn !dead_ends; None
in
match dfs [] starting_file with
| None -> Resources.elements files
| Some cycle -> cycle
in
let needed_in_order = ref [] in
let needed = ref Resources.empty in
let seen = ref Resources.empty in
let rec aux fn =
if sys_file_exists fn && not (Resources.mem fn !needed) then begin
if Resources.mem fn !seen then
raise (Circular_dependencies (refine_cycle !seen fn, fn));
seen := Resources.add fn !seen;
Resources.iter begin fun f ->
if sys_file_exists f then
if Filename.check_suffix f ".cmi" then
let f' = caml_obj_ext_of_cmi f in
if f' <> fn then
if sys_file_exists f' then aux f'
else if pack_mode then aux f else ()
else ()
else aux f
end (dependencies_of fn);
needed := Resources.add fn !needed;
needed_in_order := fn :: !needed_in_order
end
in
List.iter aux fns;
mydprintf "caml_transitive_closure:@ %a ->@ %a"
pp_l fns pp_l !needed_in_order;
List.rev !needed_in_order
end

45
ocamlbuild/ocaml_dependencies.mli
View File

@ -1,45 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(** OCaml dependencies *)
exception Circular_dependencies of string list * string
(** Give to this module a way to access libraries, packages,
and dependencies between files. *)
module type INPUT = sig
val fold_dependencies : (string -> string -> 'a -> 'a) -> 'a -> 'a
val fold_libraries : (string -> string list -> 'a -> 'a) -> 'a -> 'a
val fold_packages : (string -> string list -> 'a -> 'a) -> 'a -> 'a
end
(** Wait an [INPUT] module and gives a function to compute the
transitive closure of caml file takeing in account libraries and packages. *)
module Make (I : INPUT) : sig
(** [caml_transitive_closure] takes a list of root ocaml compiled files and returns
the list of files that must be given to a linker. Optionally you can change the
extension of caml object/library files (cmo/cma by default); use the pack mode
(false by default) to include only root files (just sort them); and gives the
list of used libraries (empty by default). *)
val caml_transitive_closure :
?caml_obj_ext:string ->
?caml_lib_ext:string ->
?pack_mode:bool ->
?used_libraries:string list ->
?hidden_packages:string list ->
Pathname.t list -> Pathname.t list
end

816
ocamlbuild/ocaml_specific.ml
View File

@ -1,816 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
open Format
open Log
open Pathname.Operators
open Tags.Operators
open Rule
open Tools
open Rule.Common_commands
open Outcome
open Command;;
open Ocaml_utils
module C_tools = struct
let link_C_library clib a libname env build =
let clib = env clib and a = env a and libname = env libname in
let objs = string_list_of_file clib in
let include_dirs = Pathname.include_dirs_of (Pathname.dirname a) in
let obj_of_o x =
if Filename.check_suffix x ".o" && !Options.ext_obj <> "o" then
Pathname.update_extension !Options.ext_obj x
else x in
let resluts = build (List.map (fun o -> List.map (fun dir -> dir / obj_of_o o) include_dirs) objs) in
let objs = List.map begin function
| Good o -> o
| Bad exn -> raise exn
end resluts in
Cmd(S[!Options.ocamlmklib; A"-o"; Px libname; T(tags_of_pathname a++"c"++"ocamlmklib"); atomize objs]);;
end
open Flags
open Command
open Rule
let init () = let module M = struct
let ext_lib = !Options.ext_lib;;
let ext_obj = !Options.ext_obj;;
let ext_dll = !Options.ext_dll;;
let x_o = "%"-.-ext_obj;;
let x_a = "%"-.-ext_lib;;
let x_dll = "%"-.-ext_dll;;
let x_p_o = "%.p"-.-ext_obj;;
let x_p_a = "%.p"-.-ext_lib;;
let x_p_dll = "%.p"-.-ext_dll;;
(* -output-obj targets *)
let x_byte_c = "%.byte.c";;
let x_byte_o = "%.byte"-.-ext_obj;;
let x_byte_so = "%.byte"-.-ext_dll;;
let x_native_o = "%.native"-.-ext_obj;;
let x_native_so = "%.native"-.-ext_dll;;
rule "target files"
~dep:"%.itarget"
~stamp:"%.otarget"
~doc:"If foo.itarget contains a list of ocamlbuild targets, \
asking ocamlbuild to produce foo.otarget will \
build each of those targets in turn."
begin fun env build ->
let itarget = env "%.itarget" in
let targets =
let dir = Pathname.dirname itarget in
let files = string_list_of_file itarget in
List.map (fun file -> [Pathname.concat dir file]) files
in
let results = List.map Outcome.good (build targets) in
let link_command result =
Cmd (S [A "ln"; A "-sf";
P (Pathname.concat !Options.build_dir result);
A Pathname.pwd])
in
if not !Options.make_links
then Nop
else Seq (List.map link_command results)
end;;
rule "ocaml: mli -> cmi"
~prod:"%.cmi"
~deps:["%.mli"; "%.mli.depends"]
(Ocaml_compiler.compile_ocaml_interf "%.mli" "%.cmi");;
rule "ocaml: mlpack & d.cmo* -> d.cmo & cmi"
~prods:["%.d.cmo"]
~deps:["%.mlpack"; "%.cmi"]
(Ocaml_compiler.byte_debug_pack_mlpack "%.mlpack" "%.d.cmo");;
rule "ocaml: mlpack & cmo* & cmi -> cmo"
~prod:"%.cmo"
~deps:["%.mli"; "%.cmi"; "%.mlpack"]
~doc:"If foo.mlpack contains a list of capitalized module names, \
the target foo.cmo will produce a packed module containing \
those modules as submodules. You can also have a foo.mli file \
to restrict the interface of the resulting module.
\
Warning: to produce a native foo.cmx out of a foo.mlpack, you must \
manually tag the included compilation units with for-pack(foo). \
See the documentation of the corresponding rules for more details.
\
The modules named in the .mlpack \
will be dynamic dependencies of the compilation action. \
You cannot give the .mlpack the same name as one of the module \
it contains, as this would create a circular dependency."
(Ocaml_compiler.byte_pack_mlpack "%.mlpack" "%.cmo");;
rule "ocaml: mlpack & cmo* -> cmo & cmi"
~prods:["%.cmo"; "%.cmi"]
~dep:"%.mlpack"
(Ocaml_compiler.byte_pack_mlpack "%.mlpack" "%.cmo");;
rule "ocaml: ml & cmi -> d.cmo"
~prod:"%.d.cmo"
~deps:["%.mli"(* This one is inserted to force this rule to be skiped when
a .ml is provided without a .mli *); "%.ml"; "%.ml.depends"; "%.cmi"]
~doc:"The foo.d.cmo target compiles foo.ml with the 'debug' tag enabled (-g).\
See also foo.d.byte.
\
For technical reason, .d.cmx and .d.native are not yet supported, \
so you should explicitly add the 'debug' tag \
to native targets (both compilation and linking)."
(Ocaml_compiler.byte_compile_ocaml_implem ~tag:"debug" "%.ml" "%.d.cmo");;
rule "ocaml: ml & cmi -> cmo"
~prod:"%.cmo"
~deps:["%.mli"(* This one is inserted to force this rule to be skiped when
a .ml is provided without a .mli *); "%.ml"; "%.ml.depends"; "%.cmi"]
(Ocaml_compiler.byte_compile_ocaml_implem "%.ml" "%.cmo");;
rule "ocaml: mlpack & cmi & p.cmx* & p.o* -> p.cmx & p.o"
~prods:["%.p.cmx"; x_p_o
(* no cmi here you must make the byte version to have it *)]
~deps:["%.mlpack"; "%.cmi"]
(Ocaml_compiler.native_profile_pack_mlpack "%.mlpack" "%.p.cmx");;
rule "ocaml: mlpack & cmi & cmx* & o* -> cmx & o"
~prods:["%.cmx"; x_o
(* no cmi here you must make the byte version to have it *)]
~deps:["%.mlpack"; "%.cmi"]
~doc:"If foo.mlpack contains a list of capitalized module names, \
the target foo.cmx will produce a packed module containing \
those modules as submodules.
\
Warning: The .cmx files that will be included must be manually tagged \
with the tag \"for-pack(foo)\". This means that you cannot include \
the same bar.cmx in several .mlpack files, and that you should not \
use an included .cmx as a separate module on its own.
\
This requirement comes from a technical limitation of \
native module packing: ocamlopt needs the -for-pack argument to be passed \
ahead of time, when compiling each included submodule, \
because there is no reliable, portable way to rewrite \
native object files afterwards."
(Ocaml_compiler.native_pack_mlpack "%.mlpack" "%.cmx");;
rule "ocaml: ml & cmi -> p.cmx & p.o"
~prods:["%.p.cmx"; x_p_o]
~deps:["%.ml"; "%.ml.depends"; "%.cmi"]
~doc:"The foo.p.cmx target compiles foo.ml with the 'profile' \
tag enabled (-p). Note that ocamlbuild provides no support \
for the bytecode profiler, which works completely differently."
(Ocaml_compiler.native_compile_ocaml_implem ~tag:"profile" ~cmx_ext:"p.cmx" "%.ml");;
rule "ocaml: ml & cmi -> cmx & o"
~prods:["%.cmx"; x_o]
~deps:["%.ml"; "%.ml.depends"; "%.cmi"]
(Ocaml_compiler.native_compile_ocaml_implem "%.ml");;
rule "ocaml: ml -> d.cmo & cmi"
~prods:["%.d.cmo"]
~deps:["%.ml"; "%.ml.depends"; "%.cmi"]
(Ocaml_compiler.byte_compile_ocaml_implem ~tag:"debug" "%.ml" "%.d.cmo");;
rule "ocaml: ml -> cmo & cmi"
~prods:["%.cmo"; "%.cmi"]
~deps:["%.ml"; "%.ml.depends"]
~doc:"This rule allows to produce a .cmi from a .ml file \
when the corresponding .mli is missing.
\
Note: you are strongly encourage to have a .mli file \
for each of your .ml module, as it is a good development \
practice which also simplifies the way build systems work, \
as it avoids producing .cmi files as a silent side-effect of \
another compilation action."
(Ocaml_compiler.byte_compile_ocaml_implem "%.ml" "%.cmo");;
rule "ocaml: d.cmo* -> d.byte"
~prod:"%.d.byte"
~dep:"%.d.cmo"
~doc:"The target foo.d.byte will build a bytecode executable \
with debug information enabled."
(Ocaml_compiler.byte_debug_link "%.d.cmo" "%.d.byte");;
rule "ocaml: cmo* -> byte"
~prod:"%.byte"
~dep:"%.cmo"
(Ocaml_compiler.byte_link "%.cmo" "%.byte");;
rule "ocaml: cmo* -> byte.(o|obj)"
~prod:x_byte_o
~dep:"%.cmo"
~doc:"The foo.byte.o target, or foo.byte.obj under Windows, \
will produce an object file by passing the -output-obj option \
to the OCaml compiler. See also foo.byte.c, and foo.native.{o,obj}."
(Ocaml_compiler.byte_output_obj "%.cmo" x_byte_o);;
rule "ocaml: cmo* -> byte.c"
~prod:x_byte_c
~dep:"%.cmo"
(Ocaml_compiler.byte_output_obj "%.cmo" x_byte_c);;
rule "ocaml: cmo* -> byte.(so|dll|dylib)"
~prod:x_byte_so
~dep:"%.cmo"
~doc:"The foo.byte.so target, or foo.byte.dll under Windows, \
or foo.byte.dylib under Mac OS X will produce a shared library file
by passing the -output-obj and -cclib -shared options \
to the OCaml compiler. See also foo.native.{so,dll,dylib}."
(Ocaml_compiler.byte_output_shared "%.cmo" x_byte_so);;
rule "ocaml: p.cmx* & p.o* -> p.native"
~prod:"%.p.native"
~deps:["%.p.cmx"; x_p_o]
~doc:"The foo.p.native target builds the native executable \
with the 'profile' tag (-p) enabled throughout compilation and linking."
(Ocaml_compiler.native_profile_link "%.p.cmx" "%.p.native");;
rule "ocaml: cmx* & o* -> native"
~prod:"%.native"
~deps:["%.cmx"; x_o]
~doc:"Builds a native executable"
(Ocaml_compiler.native_link "%.cmx" "%.native");;
rule "ocaml: cmx* & o* -> native.(o|obj)"
~prod:x_native_o
~deps:["%.cmx"; x_o]
(Ocaml_compiler.native_output_obj "%.cmx" x_native_o);;
rule "ocaml: cmx* & o* -> native.(so|dll|dylib)"
~prod:x_native_so
~deps:["%.cmx"; x_o]
(Ocaml_compiler.native_output_shared "%.cmx" x_native_so);;
rule "ocaml: mllib & d.cmo* -> d.cma"
~prod:"%.d.cma"
~dep:"%.mllib"
(Ocaml_compiler.byte_debug_library_link_mllib "%.mllib" "%.d.cma");;
rule "ocaml: mllib & cmo* -> cma"
~prod:"%.cma"
~dep:"%.mllib"
~doc:"Build a .cma archive file (bytecode library) containing \
the list of modules given in the .mllib file of the same name. \
Note that the .cma archive will contain exactly the modules listed, \
so it may not be self-contained if some dependencies are missing."
(Ocaml_compiler.byte_library_link_mllib "%.mllib" "%.cma");;
rule "ocaml: d.cmo* -> d.cma"
~prod:"%.d.cma"
~dep:"%.d.cmo"
(Ocaml_compiler.byte_debug_library_link "%.d.cmo" "%.d.cma");;
rule "ocaml: cmo* -> cma"
~prod:"%.cma"
~dep:"%.cmo"
~doc:"The preferred way to build a .cma archive is to create a .mllib file \
with a list of modules to include. It is however possible to build one \
from a .cmo of the same name; the archive will include this module and \
the local modules it depends upon, transitively."
(Ocaml_compiler.byte_library_link "%.cmo" "%.cma");;
rule "ocaml C stubs: clib & (o|obj)* -> (a|lib) & (so|dll)"
~prods:(["%(path:<**/>)lib%(libname:<*> and not <*.*>)"-.-ext_lib] @
if Ocamlbuild_config.supports_shared_libraries then
["%(path:<**/>)dll%(libname:<*> and not <*.*>)"-.-ext_dll]
else
[])
~dep:"%(path)lib%(libname).clib"
?doc:None (* TODO document *)
(C_tools.link_C_library "%(path)lib%(libname).clib" ("%(path)lib%(libname)"-.-ext_lib) "%(path)%(libname)");;
rule "ocaml: mllib & p.cmx* & p.o* -> p.cmxa & p.a"
~prods:["%.p.cmxa"; x_p_a]
~dep:"%.mllib"
(Ocaml_compiler.native_profile_library_link_mllib "%.mllib" "%.p.cmxa");;
rule "ocaml: mllib & cmx* & o* -> cmxa & a"
~prods:["%.cmxa"; x_a]
~dep:"%.mllib"
~doc:"Creates a native archive file .cmxa, using the .mllib file \
as the .cma rule above. Note that whereas bytecode .cma can \
be used both for static and dynamic linking, .cmxa only support \
static linking. For an archive usable with Dynlink, \
see the rule producing a .cmxs from a .mldylib."
(Ocaml_compiler.native_library_link_mllib "%.mllib" "%.cmxa");;
rule "ocaml: p.cmx & p.o -> p.cmxa & p.a"
~prods:["%.p.cmxa"; x_p_a]
~deps:["%.p.cmx"; x_p_o]
(Ocaml_compiler.native_profile_library_link "%.p.cmx" "%.p.cmxa");;
rule "ocaml: cmx & o -> cmxa & a"
~prods:["%.cmxa"; x_a]
~deps:["%.cmx"; x_o]
~doc:"Just as you can build a .cma from a .cmo in absence of .mllib file, \
you can build a .cmxa (native archive file for static linking only) \
from a .cmx, which will include the local modules it depends upon, \
transitivitely."
(Ocaml_compiler.native_library_link "%.cmx" "%.cmxa");;
rule "ocaml: mldylib & p.cmx* & p.o* -> p.cmxs & p.so"
~prods:["%.p.cmxs"; x_p_dll]
~dep:"%.mldylib"
(Ocaml_compiler.native_profile_shared_library_link_mldylib "%.mldylib" "%.p.cmxs");;
rule "ocaml: mldylib & cmx* & o* -> cmxs & so"
~prods:["%.cmxs"; x_dll]
~dep:"%.mldylib"
~doc:"Builds a .cmxs (native archive for dynamic linking) containing exactly \
the modules listed in the corresponding .mldylib file."
(Ocaml_compiler.native_shared_library_link_mldylib "%.mldylib" "%.cmxs");;
rule "ocaml: p.cmx & p.o -> p.cmxs & p.so"
~prods:["%.p.cmxs"; x_p_dll]
~deps:["%.p.cmx"; x_p_o]
(Ocaml_compiler.native_shared_library_link ~tags:["profile"] "%.p.cmx" "%.p.cmxs");;
rule "ocaml: p.cmxa & p.a -> p.cmxs & p.so"
~prods:["%.p.cmxs"; x_p_dll]
~deps:["%.p.cmxa"; x_p_a]
(Ocaml_compiler.native_shared_library_link ~tags:["profile";"linkall"] "%.p.cmxa" "%.p.cmxs");;
rule "ocaml: cmx & o -> cmxs"
~prods:["%.cmxs"]
~deps:["%.cmx"; x_o]
~doc:"If you have not created a foo.mldylib file for a compilation unit \
foo.cmx, the target foo.cmxs will produce a .cmxs file containing \
exactly the .cmx.
\
Note: this differs from the behavior of .cmxa targets \
with no .mllib, as the dependencies of the modules will not be \
included: generally, the modules compiled as dynamic plugins depend \
on library modules that will be already linked in the executable, \
and that the .cmxs should therefore not duplicate."
(Ocaml_compiler.native_shared_library_link "%.cmx" "%.cmxs");;
rule "ocaml: cmx & o -> cmxs & so"
~prods:["%.cmxs"; x_dll]
~deps:["%.cmx"; x_o]
(Ocaml_compiler.native_shared_library_link "%.cmx" "%.cmxs");;
rule "ocaml: cmxa & a -> cmxs & so"
~prods:["%.cmxs"; x_dll]
~deps:["%.cmxa"; x_a]
~doc:"This rule allows to build a .cmxs from a .cmxa, to avoid having \
to duplicate a .mllib file into a .mldylib."
(Ocaml_compiler.native_shared_library_link ~tags:["linkall"] "%.cmxa" "%.cmxs");;
rule "ocaml dependencies ml"
~prod:"%.ml.depends"
~dep:"%.ml"
~doc:"OCamlbuild will use ocamldep to approximate dependencies \
of a source file. The ocamldep tool being purely syntactic, \
it only computes an over-approximation of the dependencies.
\
If you manipulate a module Foo that is in fact a submodule Bar.Foo \
(after 'open Bar'), ocamldep may believe that your module depends \
on foo.ml -- when such a file also exists in your project. This can \
lead to spurious circular dependencies. In that case, you can use \
OCamlbuild_plugin.non_dependency in your myocamlbuild.ml \
to manually remove the spurious dependency. See the plugins API."
(Ocaml_tools.ocamldep_command "%.ml" "%.ml.depends");;
rule "ocaml dependencies mli"
~prod:"%.mli.depends"
~dep:"%.mli"
(Ocaml_tools.ocamldep_command "%.mli" "%.mli.depends");;
rule "ocamllex"
~prod:"%.ml"
~dep:"%.mll"
(Ocaml_tools.ocamllex "%.mll");;
rule "ocaml: mli -> odoc"
~prod:"%.odoc"
~deps:["%.mli"; "%.mli.depends"]
~doc:".odoc are intermediate files storing the result of ocamldoc processing \
on a source file. See the various .docdir/... targets for ocamldoc."
(Ocaml_tools.document_ocaml_interf "%.mli" "%.odoc");;
rule "ocaml: ml -> odoc"
~prod:"%.odoc"
~deps:["%.ml"; "%.ml.depends"]
(Ocaml_tools.document_ocaml_implem "%.ml" "%.odoc");;
rule "ocamldoc: document ocaml project odocl & *odoc -> docdir (html)"
~prod:"%.docdir/index.html"
~stamp:"%.docdir/html.stamp"
~dep:"%.odocl"
~doc:"If you put a list of capitalized module names in a foo.odocl file, \
the target foo.docdir/index.html will call ocamldoc to produce \
the html documentation for these modules. \
See also the max|latex|doc target below."
(Ocaml_tools.document_ocaml_project
~ocamldoc:Ocaml_tools.ocamldoc_l_dir "%.odocl" "%.docdir/index.html" "%.docdir");;
rule "ocamldoc: document ocaml project odocl & *odoc -> docdir (man)"
~prod:"%.docdir/man"
~stamp:"%.docdir/man.stamp"
~dep:"%.odocl"
?doc:None (* TODO document *)
(Ocaml_tools.document_ocaml_project
~ocamldoc:Ocaml_tools.ocamldoc_l_dir "%.odocl" "%.docdir/man" "%.docdir");;
rule "ocamldoc: document ocaml project odocl & *odoc -> man|latex|dot..."
~prod:"%(dir).docdir/%(file)"
~dep:"%(dir).odocl"
?doc:None (* TODO document *)
(Ocaml_tools.document_ocaml_project
~ocamldoc:Ocaml_tools.ocamldoc_l_file "%(dir).odocl" "%(dir).docdir/%(file)" "%(dir).docdir");;
(* To use menhir give the -use-menhir option at command line,
Or put true: use_menhir in your tag file. *)
if !Options.use_menhir || Configuration.has_tag "use_menhir" then begin
(* Automatic handling of menhir modules, given a
description file %.mlypack *)
rule "ocaml: modular menhir (mlypack)"
~prods:["%.mli" ; "%.ml"]
~deps:["%.mlypack"]
~doc:"Menhir supports building a parser by composing several .mly files \
together, containing different parts of the grammar description. \
To use that feature with ocamlbuild, you should create a .mlypack \
file with the same syntax as .mllib or .mlpack files: \
a whitespace-separated list of the capitalized module names \
of the .mly files you want to combine together."
(Ocaml_tools.menhir_modular "%" "%.mlypack" "%.mlypack.depends");
rule "ocaml: menhir modular dependencies"
~prod:"%.mlypack.depends"
~dep:"%.mlypack"
(Ocaml_tools.menhir_modular_ocamldep_command "%.mlypack" "%.mlypack.depends");
rule "ocaml: menhir"
~prods:["%.ml"; "%.mli"]
~deps:["%.mly"; "%.mly.depends"]
~doc:"Invokes menhir to build the .ml and .mli files derived from a .mly \
grammar. If you want to use ocamlyacc instead, you must disable the \
-use-menhir option that was passed to ocamlbuild."
(Ocaml_tools.menhir "%.mly");
rule "ocaml: menhir dependencies"
~prod:"%.mly.depends"
~dep:"%.mly"
(Ocaml_tools.menhir_ocamldep_command "%.mly" "%.mly.depends");
end else
rule "ocamlyacc"
~prods:["%.ml"; "%.mli"]
~dep:"%.mly"
~doc:"By default, ocamlbuild will use ocamlyacc to produce a .ml and .mly \
from a .mly file of the same name. You can also enable the \
-use-menhir option to use menhir instead. Menhir is a recommended \
replacement for ocamlyacc, that supports more feature, lets you \
write more readable grammars, and helps you understand conflicts."
(Ocaml_tools.ocamlyacc "%.mly");;
rule "ocaml C stubs: c -> o"
~prod:x_o
~dep:"%.c"
?doc:None (* TODO document *)
begin fun env _build ->
let c = env "%.c" in
let o = env x_o in
let comp = if Tags.mem "native" (tags_of_pathname c) then !Options.ocamlopt else !Options.ocamlc in
Cmd(S[comp; T(tags_of_pathname c++"c"++"compile"); A"-c"; A"-o"; P o; Px c])
end;;
rule "ocaml: ml & ml.depends & *cmi -> .inferred.mli"
~prod:"%.inferred.mli"
~deps:["%.ml"; "%.ml.depends"]
~doc:"The target foo.inferred.mli will produce a .mli that exposes all the \
declarations in foo.ml, as obtained by direct invocation of `ocamlc -i`."
(Ocaml_tools.infer_interface "%.ml" "%.inferred.mli");;
rule "ocaml: mltop -> top"
~prod:"%.top"
~dep:"%.mltop"
?doc:None (* TODO document *)
(Ocaml_compiler.byte_toplevel_link_mltop "%.mltop" "%.top");;
rule "preprocess: ml -> pp.ml"
~dep:"%.ml"
~prod:"%.pp.ml"
~doc:"The target foo.pp.ml should generate a source file equivalent \
to foo.ml after syntactic preprocessors (camlp4, etc.) have been \
applied.
\
Warning: This option is currently known to malfunction \
when used together with -use-ocamlfind (for syntax extensions \
coming from ocamlfind packages). Direct compilation of the \
corresponding file to produce a .cmx or .cmo will still work well."
(Ocaml_tools.camlp4 "pp.ml" "%.ml" "%.pp.ml");;
flag ["ocaml"; "pp"] begin
S (List.fold_right (fun x acc -> Sh x :: acc) !Options.ocaml_ppflags [])
end;;
flag ["ocaml"; "compile"] begin
atomize !Options.ocaml_cflags
end;;
flag ["c"; "compile"] begin
atomize !Options.ocaml_cflags
end;;
flag ["ocaml"; "link"] begin
atomize !Options.ocaml_lflags
end;;
flag ["c"; "link"] begin
atomize !Options.ocaml_lflags
end;;
flag ["ocaml"; "ocamlyacc"] (atomize !Options.ocaml_yaccflags);;
flag ["ocaml"; "menhir"] (atomize !Options.ocaml_yaccflags);;
flag ["ocaml"; "doc"] (atomize !Options.ocaml_docflags);;
flag ["ocaml"; "ocamllex"] (atomize !Options.ocaml_lexflags);;
(* Tell menhir to explain conflicts *)
flag [ "ocaml" ; "menhir" ; "explain" ] (S[A "--explain"]);;
flag [ "ocaml" ; "menhir" ; "infer" ] (S[A "--infer"]);;
(* Define two ocamlbuild flags [only_tokens] and [external_tokens(Foo)]
which correspond to menhir's [--only-tokens] and [--external-tokens Foo].
When they are used, these flags should be passed both to [menhir] and to
[menhir --raw-depend]. *)
let () =
List.iter begin fun mode ->
flag [ mode; "only_tokens" ] (S[A "--only-tokens"]);
pflag [ mode ] "external_tokens" (fun name ->
S[A "--external-tokens"; A name]);
end [ "menhir"; "menhir_ocamldep" ];;
(* Tell ocamllex to generate ml code *)
flag [ "ocaml" ; "ocamllex" ; "generate_ml" ] (S[A "-ml"]);;
flag ["ocaml"; "byte"; "link"] begin
S (List.map (fun x -> A (x^".cma")) !Options.ocaml_libs)
end;;
flag ["ocaml"; "native"; "link"] begin
S (List.map (fun x -> A (x^".cmxa")) !Options.ocaml_libs)
end;;
flag ["ocaml"; "byte"; "link"] begin
S (List.map (fun x -> A (x^".cmo")) !Options.ocaml_mods)
end;;
flag ["ocaml"; "native"; "link"] begin
S (List.map (fun x -> A (x^".cmx")) !Options.ocaml_mods)
end;;
(* findlib *)
let () =
if !Options.use_ocamlfind then begin
(* Ocamlfind will link the archives for us. *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
flag ["ocaml"; "link"; "toplevel"] & A"-linkpkg";
flag ["ocaml"; "link"; "output_obj"] & A"-linkpkg";
(* "program" will make sure that -linkpkg is passed when compiling
whole-programs (.byte and .native); but it is occasionally
useful to pass -linkpkg when building archives for example
(.cma and .cmxa); the "linkpkg" flag allows user to request it
explicitly. *)
flag ["ocaml"; "link"; "linkpkg"] & A"-linkpkg";
pflag ["ocaml"; "link"] "dontlink" (fun pkg -> S[A"-dontlink"; A pkg]);
let all_tags = [
["ocaml"; "byte"; "compile"];
["ocaml"; "native"; "compile"];
["ocaml"; "byte"; "link"];
["ocaml"; "native"; "link"];
["ocaml"; "ocamldep"];
["ocaml"; "doc"];
["ocaml"; "mktop"];
["ocaml"; "infer_interface"];
(* PR#6794: ocamlbuild should pass -package flags when building C files *)
["c"; "compile"];
] in
(* tags package(X), predicate(X) and syntax(X) *)
List.iter begin fun tags ->
pflag tags "package" (fun pkg -> S [A "-package"; A pkg]);
if not (List.mem "ocamldep" tags) then
(* PR#6184: 'ocamlfind ocamldep' does not support -predicate *)
pflag tags "predicate" (fun pkg -> S [A "-predicates"; A pkg]);
if List.mem "ocaml" tags then
pflag tags "syntax" (fun pkg -> S [A "-syntax"; A pkg])
end all_tags
end else begin
try
(* Note: if there is no -pkg option, ocamlfind won't be called *)
let pkgs = List.map Findlib.query !Options.ocaml_pkgs in
flag ["ocaml"; "byte"; "compile"] (Findlib.compile_flags_byte pkgs);
flag ["ocaml"; "native"; "compile"] (Findlib.compile_flags_native pkgs);
flag ["ocaml"; "byte"; "link"] (Findlib.link_flags_byte pkgs);
flag ["ocaml"; "native"; "link"] (Findlib.link_flags_native pkgs);
(* PR#6794: ocamlbuild should pass -package flags when building C files *)
flag ["c"; "compile"] (Findlib.include_flags pkgs)
with Findlib.Findlib_error e ->
Findlib.report_error e
end
(* parameterized tags *)
let () =
pflag ["ocaml"; "native"; "compile"] "for-pack"
(fun param -> S [A "-for-pack"; A param]);
pflag ["ocaml"; "native"; "pack"] "for-pack"
(fun param -> S [A "-for-pack"; A param]);
pflag ["ocaml"; "native"; "compile"] "inline"
(fun param -> S [A "-inline"; A param]);
pflag ["ocaml"; "compile"] "color" (fun setting -> S[A "-color"; A setting]);
List.iter (fun pp ->
pflag ["ocaml"; "compile"] pp
(fun param -> S [A ("-" ^ pp); A param]);
pflag ["ocaml"; "ocamldep"] pp
(fun param -> S [A ("-" ^ pp); A param]);
pflag ["ocaml"; "doc"] pp
(fun param -> S [A ("-" ^ pp); A param]);
pflag ["ocaml"; "infer_interface"] pp
(fun param -> S [A ("-" ^ pp); A param])
) ["pp"; "ppx"];
pflag ["ocaml";"compile";] "warn"
(fun param -> S [A "-w"; A param]);
pflag ["ocaml";"compile";] "warn_error"
(fun param -> S [A "-warn-error"; A param]);
pflag ["ocaml"; "ocamldep"] "open"
(fun param -> S [A "-open"; A param]);
pflag ["ocaml"; "compile"] "open"
(fun param -> S [A "-open"; A param]);
pflag ["ocaml"; "link"] "runtime_variant"
(fun param -> S [A "-runtime-variant"; A param]);
()
let camlp4_flags camlp4s =
List.iter begin fun camlp4 ->
flag ["ocaml"; "pp"; camlp4] (A camlp4)
end camlp4s;;
let p4_series = ["camlp4o"; "camlp4r"; "camlp4of"; "camlp4rf"; "camlp4orf"; "camlp4oof"];;
let p4_opt_series = List.map (fun f -> f ^ ".opt") p4_series;;
camlp4_flags p4_series;;
camlp4_flags p4_opt_series;;
let camlp4_flags' camlp4s =
List.iter begin fun (camlp4, flags) ->
flag ["ocaml"; "pp"; camlp4] flags
end camlp4s;;
camlp4_flags' ["camlp4orr", S[A"camlp4of"; A"-parser"; A"reloaded"];
"camlp4rrr", S[A"camlp4rf"; A"-parser"; A"reloaded"]];;
flag ["ocaml"; "pp"; "camlp4:no_quot"] (A"-no_quot");;
ocaml_lib ~extern:true "dynlink";;
ocaml_lib ~extern:true "unix";;
ocaml_lib ~extern:true "str";;
ocaml_lib ~extern:true "bigarray";;
ocaml_lib ~extern:true "nums";;
ocaml_lib ~extern:true "dbm";;
ocaml_lib ~extern:true "graphics";;
ocaml_lib ~extern:true ~tag_name:"use_toplevel" "toplevellib";;
ocaml_lib ~extern:true ~dir:"+ocamldoc" "ocamldoc";;
ocaml_lib ~extern:true ~dir:"+ocamlbuild" ~tag_name:"use_ocamlbuild" "ocamlbuildlib";;
let camlp4dir =
Findlib.(
try
if sys_command "sh -c 'ocamlfind list >/dev/null' 2>/dev/null" != 0
then raise (Findlib_error Cannot_run_ocamlfind);
(query "camlp4").location
with Findlib_error _ ->
"+camlp4"
);;
ocaml_lib ~extern:true ~dir:camlp4dir ~tag_name:"use_camlp4" "camlp4lib";;
ocaml_lib ~extern:true ~dir:camlp4dir ~tag_name:"use_old_camlp4" "camlp4";;
ocaml_lib ~extern:true ~dir:camlp4dir ~tag_name:"use_camlp4_full" "camlp4fulllib";;
flag ["ocaml"; "compile"; "use_camlp4_full"]
(S[A"-I"; A(camlp4dir^"/Camlp4Parsers");
A"-I"; A(camlp4dir^"/Camlp4Printers");
A"-I"; A(camlp4dir^"/Camlp4Filters")]);;
flag ["ocaml"; "use_camlp4_bin"; "link"; "byte"] (A(camlp4dir^"/Camlp4Bin.cmo"));;
flag ["ocaml"; "use_camlp4_bin"; "link"; "native"] (A(camlp4dir^"/Camlp4Bin.cmx"));;
flag ["ocaml"; "debug"; "compile"; "byte"] (A "-g");;
flag ["ocaml"; "debug"; "link"; "byte"; "program"] (A "-g");;
flag ["ocaml"; "debug"; "pack"; "byte"] (A "-g");;
flag ["ocaml"; "debug"; "compile"; "native"] (A "-g");;
flag ["ocaml"; "debug"; "link"; "native"; "program"] (A "-g");;
flag ["ocaml"; "debug"; "pack"; "native"] (A "-g");;
flag ["c"; "debug"; "compile"] (A "-g");
flag ["c"; "debug"; "link"] (A "-g");
flag ["ocaml"; "link"; "native"; "output_obj"] (A"-output-obj");;
flag ["ocaml"; "link"; "byte"; "output_obj"] (A"-output-obj");;
flag ["ocaml"; "link"; "output_shared"] & (S[A"-cclib"; A"-shared"]);;
flag ["ocaml"; "dtypes"; "compile"] (A "-dtypes");;
flag ["ocaml"; "annot"; "compile"] (A "-annot");;
flag ["ocaml"; "annot"; "pack"] (A "-annot");;
flag ["ocaml"; "bin_annot"; "compile"] (A "-bin-annot");;
flag ["ocaml"; "bin_annot"; "pack"] (A "-bin-annot");;
flag ["ocaml"; "safe_string"; "compile"] (A "-safe-string");;
flag ["ocaml"; "safe_string"; "infer_interface"] (A "-safe-string");;
flag ["ocaml"; "unsafe_string"; "compile"] (A "-unsafe-string");;
flag ["ocaml"; "unsafe_string"; "infer_interface"] (A "-unsafe-string");;
flag ["ocaml"; "short_paths"; "compile"] (A "-short-paths");;
flag ["ocaml"; "short_paths"; "infer_interface"] (A "-short-paths");;
flag ["ocaml"; "rectypes"; "compile"] (A "-rectypes");;
flag ["ocaml"; "rectypes"; "infer_interface"] (A "-rectypes");;
flag ["ocaml"; "rectypes"; "doc"] (A "-rectypes");;
flag ["ocaml"; "rectypes"; "pack"] (A "-rectypes");;
flag ["ocaml"; "principal"; "compile"] (A "-principal");;
flag ["ocaml"; "principal"; "infer_interface"] (A "-principal");;
flag ["ocaml"; "linkall"; "link"] (A "-linkall");;
flag ["ocaml"; "link"; "profile"; "native"] (A "-p");;
flag ["ocaml"; "link"; "program"; "custom"; "byte"] (A "-custom");;
flag ["ocaml"; "link"; "library"; "custom"; "byte"] (A "-custom");;
flag ["ocaml"; "compile"; "profile"; "native"] (A "-p");;
flag ["ocaml"; "compile"; "no_alias_deps";] (A "-no-alias-deps");;
flag ["ocaml"; "compile"; "strict_formats";] (A "-strict-formats");;
flag ["ocaml"; "native"; "compile"; "opaque";] (A "-opaque");;
flag ["ocaml"; "native"; "compile"; "no_float_const_prop";] (A "-no-float-const-prop");
flag ["ocaml"; "compile"; "keep_docs";] (A "-keep-docs");
flag ["ocaml"; "compile"; "keep_locs";] (A "-keep-locs");
flag ["ocaml"; "absname"; "compile"] (A "-absname");;
flag ["ocaml"; "absname"; "infer_interface"] (A "-absname");;
flag ["ocaml"; "byte"; "compile"; "compat_32";] (A "-compat-32");;
flag ["ocaml";"compile";"native";"asm"] & S [A "-S"];;
(* threads, with or without findlib *)
flag ["ocaml"; "compile"; "thread"] (A "-thread");;
flag ["ocaml"; "link"; "thread"] (A "-thread");;
if !Options.use_ocamlfind then
(* PR#6794: Needed as we pass -package when compiling C files *)
flag ["c"; "compile"; "thread"] (A "-thread")
else begin
flag ["ocaml"; "doc"; "thread"] (S[A"-I"; A"+threads"]);
flag ["ocaml"; "link"; "thread"; "native"; "program"] (A "threads.cmxa");
flag ["ocaml"; "link"; "thread"; "byte"; "program"] (A "threads.cma");
flag ["ocaml"; "link"; "thread"; "native"; "toplevel"] (A "threads.cmxa");
flag ["ocaml"; "link"; "thread"; "byte"; "toplevel"] (A "threads.cma");
end;;
flag ["ocaml"; "compile"; "nopervasives"] (A"-nopervasives");;
flag ["ocaml"; "compile"; "nolabels"] (A"-nolabels");;
(*flag ["ocaml"; "ocamlyacc"; "quiet"] (A"-q");;*)
flag ["ocaml"; "ocamllex"; "quiet"] (A"-q");;
let ocaml_warn_flag c =
flag ~deprecated:true
["ocaml"; "compile"; sprintf "warn_%c" (Char.uppercase_ascii c)]
(S[A"-w"; A (sprintf "%c" (Char.uppercase_ascii c))]);
flag ~deprecated:true
["ocaml"; "compile"; sprintf "warn_error_%c" (Char.uppercase_ascii c)]
(S[A"-warn-error"; A (sprintf "%c" (Char.uppercase_ascii c))]);
flag ~deprecated:true
["ocaml"; "compile"; sprintf "warn_%c" (Char.lowercase_ascii c)]
(S[A"-w"; A (sprintf "%c" (Char.lowercase_ascii c))]);
flag ~deprecated:true
["ocaml"; "compile"; sprintf "warn_error_%c" (Char.lowercase_ascii c)]
(S[A"-warn-error"; A (sprintf "%c" (Char.lowercase_ascii c))]);;
List.iter ocaml_warn_flag ['A'; 'C'; 'D'; 'E'; 'F'; 'K'; 'L'; 'M'; 'P'; 'R'; 'S'; 'U'; 'V'; 'X'; 'Y'; 'Z'];;
flag ~deprecated:true
["ocaml"; "compile"; "strict-sequence"] (A "-strict-sequence");;
flag ["ocaml"; "compile"; "strict_sequence"] (A "-strict-sequence");;
flag ["ocaml"; "doc"; "docdir"; "extension:html"] (A"-html");;
flag ["ocaml"; "doc"; "docdir"; "manpage"] (A"-man");;
flag ["ocaml"; "doc"; "docfile"; "extension:dot"] (A"-dot");;
flag ["ocaml"; "doc"; "docfile"; "extension:tex"] (A"-latex");;
flag ["ocaml"; "doc"; "docfile"; "extension:ltx"] (A"-latex");;
flag ["ocaml"; "doc"; "docfile"; "extension:texi"] (A"-texi");;
ocaml_lib "ocamlbuildlib";;
ocaml_lib "ocamlbuildlightlib";;
end in ()

18
ocamlbuild/ocaml_specific.mli
View File

@ -1,18 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val init : unit -> unit

164
ocamlbuild/ocaml_tools.ml
View File

@ -1,164 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
open Pathname.Operators
open Tags.Operators
open Tools
open Command
open Ocaml_utils
let add_suffix s = List.map (fun x -> x -.- s) ;;
let ocamldep_command' tags =
let tags' = tags++"ocaml"++"ocamldep" in
S [!Options.ocamldep; T tags'; ocaml_ppflags (tags++"pp:dep"); A "-modules"]
let menhir_ocamldep_command' tags ~menhir_spec out =
let menhir = if !Options.ocamlyacc = N then V"MENHIR" else !Options.ocamlyacc in
Cmd(S[menhir; T tags; A"--raw-depend";
A"--ocamldep"; Quote (ocamldep_command' Tags.empty);
menhir_spec ; Sh ">"; Px out])
let menhir_ocamldep_command arg out env _build =
let arg = env arg and out = env out in
let tags = tags_of_pathname arg++"ocaml"++"menhir_ocamldep" in
menhir_ocamldep_command' tags ~menhir_spec:(P arg) out
let import_mlypack build mlypack =
let tags1 = tags_of_pathname mlypack in
let files = string_list_of_file mlypack in
let include_dirs = Pathname.include_dirs_of (Pathname.dirname mlypack) in
let files_alternatives =
List.map begin fun module_name ->
expand_module include_dirs module_name ["mly"]
end files
in
let files = List.map Outcome.good (build files_alternatives) in
let tags2 =
List.fold_right
(fun file -> Tags.union (tags_of_pathname file))
files tags1
in
(tags2, files)
let menhir_modular_ocamldep_command mlypack out env build =
let mlypack = env mlypack and out = env out in
let (tags,files) = import_mlypack build mlypack in
let tags = tags++"ocaml"++"menhir_ocamldep" in
let menhir_base = Pathname.remove_extensions mlypack in
let menhir_spec = S[A "--base" ; P menhir_base ; atomize_paths files] in
menhir_ocamldep_command' tags ~menhir_spec out
let menhir_modular menhir_base mlypack mlypack_depends env build =
let menhir = if !Options.ocamlyacc = N then V"MENHIR" else !Options.ocamlyacc in
let menhir_base = env menhir_base in
let mlypack = env mlypack in
let mlypack_depends = env mlypack_depends in
let (tags,files) = import_mlypack build mlypack in
let () = List.iter Outcome.ignore_good (build [[mlypack_depends]]) in
Ocaml_compiler.prepare_compile build mlypack;
let ocamlc_tags = tags++"ocaml"++"byte"++"compile" in
let tags = tags++"ocaml"++"parser"++"menhir" in
Cmd(S[menhir ;
A "--ocamlc"; Quote(S[!Options.ocamlc; T ocamlc_tags; ocaml_include_flags mlypack]);
T tags ; A "--base" ; Px menhir_base ; atomize_paths files])
let ocamldep_command arg out env _build =
let arg = env arg and out = env out in
let tags = tags_of_pathname arg in
Cmd(S[ocamldep_command' tags; P arg; Sh ">"; Px out])
let ocamlyacc mly env _build =
let mly = env mly in
let ocamlyacc = if !Options.ocamlyacc = N then V"OCAMLYACC" else !Options.ocamlyacc in
Cmd(S[ocamlyacc; T(tags_of_pathname mly++"ocaml"++"parser"++"ocamlyacc"); Px mly])
let ocamllex mll env _build =
let mll = env mll in
Cmd(S[!Options.ocamllex; T(tags_of_pathname mll++"ocaml"++"lexer"++"ocamllex"); Px mll])
let infer_interface ml mli env build =
let ml = env ml and mli = env mli in
let tags = tags_of_pathname ml++"ocaml" in
Ocaml_compiler.prepare_compile build ml;
Cmd(S[!Options.ocamlc; ocaml_ppflags tags; ocaml_include_flags ml; A"-i";
(if Tags.mem "thread" tags then A"-thread" else N);
T(tags++"infer_interface"); P ml; Sh">"; Px mli])
let menhir mly env build =
let mly = env mly in
let ml = Pathname.update_extension "ml" mly in
let menhir = if !Options.ocamlyacc = N then V"MENHIR" else !Options.ocamlyacc in
let ocamlc_tags = tags_of_pathname ml ++"ocaml"++"byte"++"compile" in
let menhir_tags = tags_of_pathname mly ++"ocaml"++"parser"++"menhir" in
Ocaml_compiler.prepare_compile build mly;
Cmd(S[menhir;
A"--ocamlc"; Quote(S[!Options.ocamlc; T ocamlc_tags; ocaml_include_flags mly]);
T menhir_tags; Px mly])
let ocamldoc_c tags arg odoc =
let tags = tags++"ocaml" in
Cmd (S [!Options.ocamldoc; A"-dump"; Px odoc; T(tags++"doc");
ocaml_ppflags (tags++"pp:doc");
ocaml_include_flags arg; P arg])
let ocamldoc_l_dir tags deps _docout docdir =
Seq[Cmd (S[A"rm"; A"-rf"; Px docdir]);
Cmd (S[A"mkdir"; A"-p"; Px docdir]);
Cmd (S [!Options.ocamldoc;
S(List.map (fun a -> S[A"-load"; P a]) deps);
T(tags++"doc"++"docdir"); A"-d"; Px docdir])]
let ocamldoc_l_file tags deps docout _docdir =
Seq[Cmd (S[A"rm"; A"-rf"; Px docout]);
Cmd (S[A"mkdir"; A"-p"; Px (Pathname.dirname docout)]);
Cmd (S [!Options.ocamldoc;
S(List.map (fun a -> S[A"-load"; P a]) deps);
T(tags++"doc"++"docfile"); A"-o"; Px docout])]
let document_ocaml_interf mli odoc env build =
let mli = env mli and odoc = env odoc in
Ocaml_compiler.prepare_compile build mli;
ocamldoc_c (tags_of_pathname mli++"interf") mli odoc
let document_ocaml_implem ml odoc env build =
let ml = env ml and odoc = env odoc in
Ocaml_compiler.prepare_compile build ml;
ocamldoc_c (tags_of_pathname ml++"implem") ml odoc
let document_ocaml_project ?(ocamldoc=ocamldoc_l_file) odocl docout docdir env build =
let odocl = env odocl and docout = env docout and docdir = env docdir in
let contents = string_list_of_file odocl in
let include_dirs = Pathname.include_dirs_of (Pathname.dirname odocl) in
let to_build =
List.map begin fun module_name ->
expand_module include_dirs module_name ["odoc"]
end contents in
let module_paths = List.map Outcome.good (build to_build) in
let tags = (Tags.union (tags_of_pathname docout) (tags_of_pathname docdir))++"ocaml" in
ocamldoc tags module_paths docout docdir
let camlp4 ?(default=A"camlp4o") tag i o env build =
let ml = env i and pp_ml = env o in
let tags = tags_of_pathname ml++"ocaml"++"pp"++tag in
let _ = Rule.build_deps_of_tags build tags in
let pp = Command.reduce (Flags.of_tags tags) in
let pp =
match pp with
| N -> default
| _ -> pp
in
Cmd(S[pp; P ml; A"-printer"; A"o"; A"-o"; Px pp_ml])

35
ocamlbuild/ocaml_tools.mli
View File

@ -1,35 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val ocamldoc_c : Tags.t -> string -> string -> Command.t
val ocamldoc_l_dir : Tags.t -> string list -> string -> string -> Command.t
val ocamldoc_l_file : Tags.t -> string list -> string -> string -> Command.t
val ocamldep_command : string -> string -> Rule.action
val menhir_ocamldep_command : string -> string -> Rule.action
val menhir_modular_ocamldep_command : string -> string -> Rule.action
val menhir_modular : string -> string -> string -> Rule.action
val ocamlyacc : string -> Rule.action
val ocamllex : string -> Rule.action
val menhir : string -> Rule.action
val infer_interface : string -> string -> Rule.action
val document_ocaml_interf : string -> string -> Rule.action
val document_ocaml_implem : string -> string -> Rule.action
val document_ocaml_project :
?ocamldoc:(Tags.t -> string list -> string -> string -> Command.t) ->
string -> string -> string -> Rule.action
val camlp4 : ?default:Command.spec -> Tags.elt -> Pathname.t -> Pathname.t -> Rule.action

179
ocamlbuild/ocaml_utils.ml
View File

@ -1,179 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
open Format
open Log
open Pathname.Operators
open Tags.Operators
open Tools
open Flags
open Command;;
module S = Set.Make(String)
let flag_and_dep tags cmd_spec =
flag tags cmd_spec;
let ps = Command.fold_pathnames (fun p ps -> p :: ps) (Cmd cmd_spec) [] in
dep tags ps
let stdlib_dir = lazy begin
let ocamlc_where = !Options.build_dir / (Pathname.mk "ocamlc.where") in
let () = Command.execute ~quiet:true (Cmd(S[!Options.ocamlc; A"-where"; Sh">"; P ocamlc_where])) in
String.chomp (read_file ocamlc_where)
end
let pflag_and_dep tags ptag cmd_spec =
Param_tags.declare ptag
(fun param ->
flag_and_dep (Param_tags.make ptag param :: tags) (cmd_spec param))
let module_name_of_filename f = String.capitalize_ascii (Pathname.remove_extensions f)
let module_name_of_pathname x =
module_name_of_filename (Pathname.to_string (Pathname.basename x))
let ignore_stdlib x =
if !Options.nostdlib then false
else
let x' = !*stdlib_dir/((String.uncapitalize_ascii x)-.-"cmi") in
Pathname.exists x'
let non_dependencies = ref []
let non_dependency m1 m2 =
(* non_dependency was not supposed to accept pathnames without extension. *)
if String.length (Pathname.get_extensions m1) = 0 then
invalid_arg "non_dependency: no extension";
non_dependencies := (m1, m2) :: !non_dependencies
let path_importance path x =
if List.mem (path, x) !non_dependencies
|| (List.mem x !Options.ignore_list) then begin
let () = dprintf 3 "This module (%s) is ignored by %s" x path in
`ignored
end
else if ignore_stdlib x then `just_try else `mandatory
let expand_module =
memo3 (fun include_dirs module_name exts ->
let dirname = Pathname.dirname module_name in
let basename = Pathname.basename module_name in
let module_name_cap = dirname/(String.capitalize_ascii basename) in
let module_name_uncap = dirname/(String.uncapitalize_ascii basename) in
List.fold_right begin fun include_dir ->
List.fold_right begin fun ext acc ->
include_dir/(module_name_uncap-.-ext) ::
include_dir/(module_name_cap-.-ext) :: acc
end exts
end include_dirs [])
let string_list_of_file file =
with_input_file file begin fun ic ->
Lexers.blank_sep_strings
Const.Source.file (Lexing.from_channel ic)
end
let print_path_list = Pathname.print_path_list
let ocaml_ppflags tags =
let flags = Flags.of_tags (tags++"ocaml"++"pp") in
let reduced = Command.reduce flags in
if reduced = N then N else S[A"-pp"; Quote reduced]
let ocaml_add_include_flag x acc =
if x = Pathname.current_dir_name then acc else A"-I" :: A x :: acc
let ocaml_include_flags path =
S (List.fold_right ocaml_add_include_flag (Pathname.include_dirs_of (Pathname.dirname path)) [])
let info_libraries = Hashtbl.create 103
let libraries = Hashtbl.create 103
let libraries_of m =
try Hashtbl.find libraries m with Not_found -> []
let use_lib m lib = Hashtbl.replace libraries m (lib :: libraries_of m)
let ocaml_lib ?(extern=false) ?(byte=true) ?(native=true) ?dir ?tag_name libpath =
let add_dir x =
match dir with
| Some dir -> S[A"-I"; P dir; x]
| None -> x
in
let tag_name =
match tag_name with
| Some x -> x
| None -> "use_" ^ Pathname.basename libpath
in
let flag_and_dep tags lib =
flag tags (add_dir (A lib));
if not extern then dep tags [lib] (* cannot happen? *)
in
Hashtbl.replace info_libraries tag_name (libpath, extern);
(* adding [tag_name] to [info_libraries] will make this tag
affect include-dir lookups, so it is used even if not
mentioned explicitly in any rule. *)
Flags.mark_tag_used tag_name;
if extern then begin
if byte then
flag_and_dep ["ocaml"; tag_name; "link"; "byte"] (libpath^".cma");
if native then
flag_and_dep ["ocaml"; tag_name; "link"; "native"] (libpath^".cmxa");
end else begin
if not byte && not native then
invalid_arg "ocaml_lib: ~byte:false or ~native:false only works with ~extern:true";
end;
match dir with
| None -> ()
| Some dir ->
List.iter
(fun x -> flag ["ocaml"; tag_name; x] (S[A"-I"; P dir]))
["compile"; "doc"; "infer_interface"]
let cmi_of = Pathname.update_extensions "cmi"
exception Ocamldep_error of string
let read_path_dependencies =
let path_dependencies = Hashtbl.create 103 in
let read path =
let module_name = module_name_of_pathname path in
let depends = path-.-"depends" in
with_input_file depends begin fun ic ->
let ocamldep_output =
try Lexers.ocamldep_output
Const.Source.ocamldep (Lexing.from_channel ic)
with Lexers.Error (msg,_) -> raise (Ocamldep_error(Printf.sprintf "Ocamldep.ocamldep: bad output (%s)" msg)) in
let deps =
List.fold_right begin fun (path, deps) acc ->
let module_name' = module_name_of_pathname path in
if module_name' = module_name
then List.union deps acc
else raise (Ocamldep_error(Printf.sprintf "Ocamldep.ocamldep: multiple files in ocamldep output (%s not expected)" path))
end ocamldep_output [] in
let deps =
if !Options.nostdlib && not (Tags.mem "nopervasives" (tags_of_pathname path)) then
"Pervasives" :: deps
else deps in
let deps' = List.fold_right begin fun dep acc ->
match path_importance path dep with
| `ignored -> acc
| (`just_try | `mandatory) as importance -> (importance, dep) :: acc
end deps [] in
Hashtbl.replace path_dependencies path
(List.union (try Hashtbl.find path_dependencies path with Not_found -> []) deps');
deps'
end
in read
let path_dependencies_of = memo read_path_dependencies

47
ocamlbuild/ocaml_utils.mli
View File

@ -1,47 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val stdlib_dir : Pathname.t Lazy.t
val module_name_of_filename : Pathname.t -> string
val module_name_of_pathname : Pathname.t -> string
val ignore_stdlib : string -> bool
val non_dependency : string -> string -> unit
val expand_module :
Pathname.t list -> Pathname.t -> string list -> Pathname.t list
val string_list_of_file : string -> string list
val ocaml_ppflags : Tags.t -> Command.spec
val ocaml_include_flags : Pathname.t -> Command.spec
val libraries_of : Pathname.t -> Pathname.t list
val use_lib : Pathname.t -> Pathname.t -> unit
val cmi_of : Pathname.t -> Pathname.t
val ocaml_add_include_flag : string -> Command.spec list -> Command.spec list
val flag_and_dep : Tags.elt list -> Command.spec -> unit
val pflag_and_dep : Tags.elt list -> Tags.elt -> (string -> Command.spec) ->
unit
exception Ocamldep_error of string
(* Takes a path and returns a list of modules *)
val path_dependencies_of : Pathname.t -> ([ `mandatory | `just_try ] * string) list
val info_libraries : (string, string * bool) Hashtbl.t
val ocaml_lib :
?extern:bool ->
?byte:bool ->
?native:bool ->
?dir:Pathname.t ->
?tag_name:string ->
Pathname.t -> unit

17
ocamlbuild/ocamlbuild.ml
View File

@ -1,17 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
Ocamlbuild_unix_plugin.setup ();
Ocamlbuild_pack.Main.main ()

16
ocamlbuild/ocamlbuild.mli
View File

@ -1,16 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(** Nothing to export for now *)

3
ocamlbuild/ocamlbuild.mltop
View File

@ -1,3 +0,0 @@
Ocamlbuild_pack
Ocamlbuild_plugin
Ocamlbuild_unix_plugin

41
ocamlbuild/ocamlbuild.odocl
View File

@ -1,41 +0,0 @@
Log
My_unix
My_std
Signatures
Shell
Display
Command
Configuration
Discard_printf
Flags
Hygiene
Options
Pathname
Report
Resource
Rule
Slurp
Solver
Tags
Tools
Fda
Ocaml_specific
Ocaml_arch
Ocamlbuild_where
Ocamlbuild_Myocamlbuild_config
Lexers
Glob
Bool
Glob_ast
Glob_lexer
Plugin
Main
Hooks
Ocaml_utils
Ocaml_tools
Ocaml_compiler
Ocaml_dependencies
Exit_codes
Digest_cache
Ocamlbuild_plugin
Findlib

351
ocamlbuild/ocamlbuild_executor.ml
View File

@ -1,351 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Ocamlbuild_executor *)
open Unix;;
type error =
| Subcommand_failed
| Subcommand_got_signal
| Io_error
| Exceptionl_condition
type task = unit -> string;;
type job = {
job_id : int * int;
job_command : string;
job_next : task list;
job_result : bool ref; (* Result of this sequence group *)
job_stdout : in_channel;
job_stdin : out_channel;
job_stderr : in_channel;
job_buffer : Buffer.t;
mutable job_dying : bool;
};;
module JS = Set.Make(struct type t = job let compare = compare end);;
module FDM = Map.Make(struct type t = file_descr let compare = compare end);;
let sf = Printf.sprintf;;
let fp = Printf.fprintf;;
(*** print_unix_status *)
(* FIXME never called *)
let print_unix_status oc = function
| WEXITED x -> fp oc "exit %d" x
| WSIGNALED i -> fp oc "signal %d" i
| WSTOPPED i -> fp oc "stop %d" i
;;
(* ***)
(*** print_job_id *)
let print_job_id oc (x,y) = fp oc "%d.%d" x y;;
(* ***)
(*** output_lines *)
let output_lines prefix oc buffer =
let u = Buffer.contents buffer in
let m = String.length u in
let output_line i j =
output_string oc prefix;
output_substring oc u i (j - i);
output_char oc '\n'
in
let rec loop i =
if i < m then
let j =
try String.index_from u i '\n'
with Not_found -> m
in
output_line i j;
loop (j + 1)
else
()
in
loop 0
;;
(* ***)
(*** execute *)
(* XXX: Add test for non reentrancy *)
let execute
?(max_jobs=max_int)
?(ticker=ignore)
?(period=0.1)
?(display=(fun f -> f Pervasives.stdout))
~exit
(commands : task list list)
=
let batch_id = ref 0 in
let env = environment () in
let jobs = ref JS.empty in
let jobs_active = ref 0 in
let jobs_to_terminate = Queue.create () in
let commands_to_execute = Queue.create () in
let all_ok = ref true in
let results =
List.map (fun tasks ->
let result = ref false in
Queue.add (tasks, result) commands_to_execute;
result)
commands
in
let outputs = ref FDM.empty in
let doi = descr_of_in_channel in
let doo = descr_of_out_channel in
(*** compute_fds *)
let compute_fds =
let fds = ref ([], [], []) in
let prev_jobs = ref JS.empty in
fun () ->
if not (!prev_jobs == !jobs) then
begin
prev_jobs := !jobs;
fds :=
JS.fold
begin fun job (rfds, wfds, xfds) ->
let ofd = doi job.job_stdout
and ifd = doo job.job_stdin
and efd = doi job.job_stderr
in
(ofd :: efd :: rfds, wfds, ofd :: ifd :: efd :: xfds)
end
!jobs
([], [], [])
end;
!fds
in
(* ***)
(*** add_job *)
let add_job cmd rest result id =
(*display begin fun oc -> fp oc "Job %a is %s\n%!" print_job_id id cmd; end;*)
let (stdout', stdin', stderr') = open_process_full cmd env in
incr jobs_active;
set_nonblock (doi stdout');
set_nonblock (doi stderr');
let job =
{ job_id = id;
job_command = cmd;
job_next = rest;
job_result = result;
job_stdout = stdout';
job_stdin = stdin';
job_stderr = stderr';
job_buffer = Buffer.create 1024;
job_dying = false }
in
outputs := FDM.add (doi stdout') job (FDM.add (doi stderr') job !outputs);
jobs := JS.add job !jobs;
in
(* ***)
(*** skip_empty_tasks *)
let rec skip_empty_tasks = function
| [] -> None
| task :: tasks ->
let cmd = task () in
if cmd = "" then skip_empty_tasks tasks else Some(cmd, tasks)
in
(* ***)
(*** add_some_jobs *)
let add_some_jobs () =
let (tasks, result) = Queue.take commands_to_execute in
match skip_empty_tasks tasks with
| None -> result := false
| Some(cmd, rest) ->
let b_id = !batch_id in
incr batch_id;
add_job cmd rest result (b_id, 0)
in
(* ***)
(*** terminate *)
let terminate ?(continue=true) job =
if not job.job_dying then
begin
job.job_dying <- true;
Queue.add (job, continue) jobs_to_terminate
end
else
()
in
(* ***)
(*** add_more_jobs_if_possible *)
let add_more_jobs_if_possible () =
while !jobs_active < max_jobs && not (Queue.is_empty commands_to_execute) do
add_some_jobs ()
done
in
(* ***)
(*** do_read *)
let do_read =
let u = Bytes.create 4096 in
fun ?(loop=false) fd job ->
(*if job.job_dying then
()
else*)
try
let rec iteration () =
let m =
try
read fd u 0 (Bytes.length u)
with
| Unix.Unix_error(e,_,_) ->
let msg = error_message e in
display (fun oc -> fp oc
"Error while reading stdout/stderr: %s\n" msg);
0
in
if m = 0 then
if job.job_dying then
()
else
terminate job
else
begin
Buffer.add_subbytes job.job_buffer u 0 m;
if loop then
iteration ()
else
()
end
in
iteration ()
with
| x ->
display
begin fun oc ->
fp oc "Exception %s while reading output of command %S\n%!" job.job_command
(Printexc.to_string x);
end;
exit Io_error
in
(* ***)
(*** process_jobs_to_terminate *)
let process_jobs_to_terminate () =
while not (Queue.is_empty jobs_to_terminate) do
ticker ();
let (job, continue) = Queue.take jobs_to_terminate in
(*display begin fun oc -> fp oc "Terminating job %a\n%!" print_job_id job.job_id; end;*)
decr jobs_active;
(* PR#5371: we would get EAGAIN below otherwise *)
clear_nonblock (doi job.job_stdout);
clear_nonblock (doi job.job_stderr);
do_read ~loop:true (doi job.job_stdout) job;
do_read ~loop:true (doi job.job_stderr) job;
outputs := FDM.remove (doi job.job_stdout) (FDM.remove (doi job.job_stderr) !outputs);
jobs := JS.remove job !jobs;
let status = close_process_full (job.job_stdout, job.job_stdin, job.job_stderr) in
let shown = ref false in
let show_command () =
if !shown then
()
else
display
begin fun oc ->
shown := true;
fp oc "+ %s\n" job.job_command;
output_lines "" oc job.job_buffer
end
in
if Buffer.length job.job_buffer > 0 then show_command ();
begin
match status with
| Unix.WEXITED 0 ->
begin
if continue then
begin
match skip_empty_tasks job.job_next with
| None -> job.job_result := true
| Some(cmd, rest) ->
let (b_id, s_id) = job.job_id in
add_job cmd rest job.job_result (b_id, s_id + 1)
end
else
all_ok := false;
end
| Unix.WEXITED rc ->
show_command ();
display (fun oc -> fp oc "Command exited with code %d.\n" rc);
all_ok := false;
exit Subcommand_failed
| Unix.WSTOPPED s | Unix.WSIGNALED s ->
show_command ();
all_ok := false;
display (fun oc -> fp oc "Command got signal %d.\n" s);
exit Subcommand_got_signal
end
done
in
(* ***)
(*** terminate_all_jobs *)
let terminate_all_jobs () =
JS.iter (terminate ~continue:false) !jobs
in
(* ***)
(*** loop *)
let rec loop () =
(*display (fun oc -> fp oc "Total %d jobs\n" !jobs_active);*)
process_jobs_to_terminate ();
add_more_jobs_if_possible ();
if JS.is_empty !jobs then
()
else
begin
let (rfds, wfds, xfds) = compute_fds () in
ticker ();
let (chrfds, chwfds, chxfds) = select rfds wfds xfds period in
List.iter
begin fun (fdlist, hook) ->
List.iter
begin fun fd ->
try
let job = FDM.find fd !outputs in
ticker ();
hook fd job
with
| Not_found -> () (* XXX *)
end
fdlist
end
[chrfds, do_read ~loop:false;
chwfds, (fun _ _ -> ());
chxfds,
begin fun _ _job ->
(*display (fun oc -> fp oc "Exceptional condition on command %S\n%!" job.job_command);
exit Exceptional_condition*)
() (* FIXME *)
end];
loop ()
end
in
try
loop ();
None
with
| x ->
begin
try
terminate_all_jobs ()
with
| x' ->
display (fun oc -> fp oc "Extra exception %s\n%!" (Printexc.to_string x'))
end;
Some(List.map (!) results, x)
;;
(* ***)

56
ocamlbuild/ocamlbuild_executor.mli
View File

@ -1,56 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Berke Durak *)
(* Ocamlbuild_executor *)
(** UNIX-specific module for running tasks in parallel and properly multiplexing their outputs. *)
type error =
| Subcommand_failed
| Subcommand_got_signal
| Io_error
| Exceptionl_condition
(** [execute ~ticker ~period ~display ~exit commands] will execute the commands
in [commands] in parallel, correctly multiplexing their outputs.
A command is a function that given a unit [()] returns the shell command
string to execute, commands are functions in order to do some job just
before executing the command. These functions will be called once. If
specified, it will call [ticker] at least every [period] seconds. If
specified, it will call [display f] when it wishes to print something;
[display] should then call [f] with then channel on which [f] should
print.
Note that if the shell command to execute is the empty string [""], it's
considered as a no-op.
Note that [f] must be idempotent as it may well be called twice, once for
the log file, once for the actual output.
If one of the commands fails, it will exit with an appropriate error code,
calling [cleanup] before.
All exits are done trough the call to the given [exit] function, if not
supplied Pervasives.exit is used.
*)
val execute :
?max_jobs:int ->
?ticker:(unit -> unit) ->
?period:float ->
?display:((out_channel -> unit) -> unit) ->
exit:(error -> unit) ->
((unit -> string) list list) ->
(bool list * exn) option

43
ocamlbuild/ocamlbuild_pack.mlpack
View File

@ -1,43 +0,0 @@
Const
Loc
Log
My_unix
My_std
Signatures
Shell
Display
Command
Configuration
Discard_printf
Flags
Hygiene
Options
Pathname
Report
Resource
Rule
Slurp
Solver
Tags
Tools
Fda
Ocaml_specific
Ocaml_arch
Ocamlbuild_where
Ocamlbuild_Myocamlbuild_config
Lexers
Glob
Bool
Glob_ast
Glob_lexer
Plugin
Main
Hooks
Ocaml_utils
Ocaml_tools
Ocaml_compiler
Ocaml_dependencies
Exit_codes
Digest_cache
Findlib
Param_tags

64
ocamlbuild/ocamlbuild_plugin.ml
View File

@ -1,64 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open Ocamlbuild_pack
include Ocamlbuild_pack.My_std
module Arch = Ocamlbuild_pack.Ocaml_arch
module Command = Ocamlbuild_pack.Command
module Pathname = Ocamlbuild_pack.Pathname
module Tags = Ocamlbuild_pack.Tags
include Pathname.Operators
include Tags.Operators
module Rule = Ocamlbuild_pack.Rule
module Options = Ocamlbuild_pack.Options
module Findlib = Ocamlbuild_pack.Findlib
type command = Command.t = Seq of command list | Cmd of spec | Echo of string list * string | Nop
and spec = Command.spec =
| N | S of spec list | A of string | P of string | Px of string
| Sh of string | T of Tags.t | V of string | Quote of spec
include Rule.Common_commands
type env = Pathname.t -> Pathname.t
type builder = Pathname.t list list -> (Pathname.t, exn) Ocamlbuild_pack.My_std.Outcome.t list
type action = env -> builder -> Command.t
let rule = Rule.rule
let clear_rules = Rule.clear_rules
let dep = Command.dep
let pdep = Command.pdep
let copy_rule = Rule.copy_rule
let ocaml_lib = Ocamlbuild_pack.Ocaml_utils.ocaml_lib
let flag = Ocamlbuild_pack.Flags.flag ?deprecated:None
let pflag = Ocamlbuild_pack.Flags.pflag
let mark_tag_used = Ocamlbuild_pack.Flags.mark_tag_used
let flag_and_dep = Ocamlbuild_pack.Ocaml_utils.flag_and_dep
let pflag_and_dep = Ocamlbuild_pack.Ocaml_utils.pflag_and_dep
let non_dependency = Ocamlbuild_pack.Ocaml_utils.non_dependency
let use_lib = Ocamlbuild_pack.Ocaml_utils.use_lib
let module_name_of_pathname = Ocamlbuild_pack.Ocaml_utils.module_name_of_pathname
let string_list_of_file = Ocamlbuild_pack.Ocaml_utils.string_list_of_file
let expand_module = Ocamlbuild_pack.Ocaml_utils.expand_module
let tags_of_pathname = Ocamlbuild_pack.Tools.tags_of_pathname
let hide_package_contents = Ocamlbuild_pack.Ocaml_compiler.hide_package_contents
let tag_file = Ocamlbuild_pack.Configuration.tag_file
let tag_any = Ocamlbuild_pack.Configuration.tag_any
let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
type hook = Ocamlbuild_pack.Hooks.message =
| Before_hygiene
| After_hygiene
| Before_options
| After_options
| Before_rules
| After_rules
let dispatch = Ocamlbuild_pack.Hooks.setup_hooks

18
ocamlbuild/ocamlbuild_plugin.mli
View File

@ -1,18 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
include Ocamlbuild_pack.Signatures.PLUGIN
with module Pathname = Ocamlbuild_pack.Pathname
and module Outcome = Ocamlbuild_pack.My_std.Outcome
and module Tags = Ocamlbuild_pack.Tags
and module Command = Ocamlbuild_pack.Command

96
ocamlbuild/ocamlbuild_unix_plugin.ml
View File

@ -1,96 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open Format
open Ocamlbuild_pack
open My_unix
let report_error f =
function
| Unix.Unix_error(err, fun_name, arg) ->
fprintf f "%s: %S failed" Sys.argv.(0) fun_name;
if String.length arg > 0 then
fprintf f " on %S" arg;
fprintf f ": %s" (Unix.error_message err)
| exn -> raise exn
let mkstat unix_stat x =
let st =
try unix_stat x
with Unix.Unix_error _ as e -> raise (Sys_error (My_std.sbprintf "%a" report_error e))
in
{ stat_key = sprintf "(%d,%d)" st.Unix.st_dev st.Unix.st_ino;
stat_file_kind =
match st.Unix.st_kind with
| Unix.S_LNK -> FK_link
| Unix.S_DIR -> FK_dir
| Unix.S_CHR | Unix.S_BLK | Unix.S_FIFO | Unix.S_SOCK -> FK_other
| Unix.S_REG -> FK_file }
let is_link s = (Unix.lstat s).Unix.st_kind = Unix.S_LNK
let at_exit_once callback =
let pid = Unix.getpid () in
at_exit begin fun () ->
if pid = Unix.getpid () then callback ()
end
let run_and_open s kont =
let ic = Unix.open_process_in s in
let close () =
match Unix.close_process_in ic with
| Unix.WEXITED 0 -> ()
| Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
failwith (Printf.sprintf "Error while running: %s" s) in
let res = try
kont ic
with e -> (close (); raise e)
in close (); res
let stdout_isatty () =
Unix.isatty Unix.stdout &&
try Unix.getenv "TERM" <> "dumb" with Not_found -> true
let execute_many =
let exit i = raise (My_std.Exit_with_code i) in
let exit = function
| Ocamlbuild_executor.Subcommand_failed -> exit Exit_codes.rc_executor_subcommand_failed
| Ocamlbuild_executor.Subcommand_got_signal -> exit Exit_codes.rc_executor_subcommand_got_signal
| Ocamlbuild_executor.Io_error -> exit Exit_codes.rc_executor_io_error
| Ocamlbuild_executor.Exceptionl_condition -> exit Exit_codes.rc_executor_excetptional_condition
in
Ocamlbuild_executor.execute ~exit
(* Ocamlbuild code assumes throughout that [readlink] will return a file name
relative to the current directory. Let's make it so. *)
let myunixreadlink x =
let y = Unix.readlink x in
if Filename.is_relative y then
Filename.concat (Filename.dirname x) y
else
y
let setup () =
implem.is_degraded <- false;
implem.stdout_isatty <- stdout_isatty;
implem.gettimeofday <- Unix.gettimeofday;
implem.report_error <- report_error;
implem.execute_many <- execute_many;
implem.readlink <- myunixreadlink;
implem.run_and_open <- run_and_open;
implem.at_exit_once <- at_exit_once;
implem.is_link <- is_link;
implem.stat <- mkstat Unix.stat;
implem.lstat <- mkstat Unix.lstat;;

16
ocamlbuild/ocamlbuild_unix_plugin.mli
View File

@ -1,16 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val setup : unit -> unit

20
ocamlbuild/ocamlbuild_where.ml
View File

@ -1,20 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
let bindir = ref Ocamlbuild_config.bindir;;
let libdir = ref begin
Filename.concat
(try Sys.getenv "OCAMLLIB"
with Not_found -> Ocamlbuild_config.libdir)
"ocamlbuild"
end;;

19
ocamlbuild/ocamlbuild_where.mli
View File

@ -1,19 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
val bindir : string ref
val libdir : string ref

4
ocamlbuild/ocamlbuildlib.mllib
View File

@ -1,4 +0,0 @@
Ocamlbuild_pack
Ocamlbuild_plugin
Ocamlbuild_unix_plugin
Ocamlbuild_executor

16
ocamlbuild/ocamlbuildlight.ml
View File

@ -1,16 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
Ocamlbuild_pack.Main.main ();;

16
ocamlbuild/ocamlbuildlight.mli
View File

@ -1,16 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
(* Nothing *)

2
ocamlbuild/ocamlbuildlightlib.mllib
View File

@ -1,2 +0,0 @@
Ocamlbuild_pack
Ocamlbuild_plugin

374
ocamlbuild/options.ml
View File

@ -1,374 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
let version = "ocamlbuild "^(Sys.ocaml_version);;
type command_spec = Command.spec
open My_std
open Arg
open Format
open Command
let entry = ref None
let project_root_dir = ref None
let build_dir = ref (Filename.concat (Sys.getcwd ()) "_build")
let include_dirs = ref []
let exclude_dirs = ref []
let nothing_should_be_rebuilt = ref false
let sanitize = ref true
let sanitization_script = ref "sanitize.sh"
let hygiene = ref true
let ignore_auto = ref true
let plugin = ref true
let just_plugin = ref false
let native_plugin = ref true
let make_links = ref true
let nostdlib = ref false
let use_menhir = ref false
let catch_errors = ref true
let use_ocamlfind = ref false
(* Currently only ocamlfind and menhir is defined as no-core tool,
perhaps later we need something better *)
let is_core_tool = function "ocamlfind" | "menhir" -> false | _ -> true
let find_tool cmd =
let dir = Ocamlbuild_where.bindir in
let core_tool = is_core_tool cmd in
let opt = cmd ^ ".opt" in
let search_in_path = memo Command.search_in_path in
if sys_file_exists !dir then
let long = filename_concat !dir cmd in
let long_opt = long ^ ".opt" in
(* This defines how the command will be found *)
let choices =
[(fun () -> if file_or_exe_exists long_opt then Some long_opt else None);
(fun () -> if file_or_exe_exists long then Some long else None)] in
(* For non core tool the preference is too look at PATH first *)
let choices' =
[fun () ->
try let _ = search_in_path opt in Some opt
with Not_found -> Some cmd]
in
let choices = if core_tool then choices @ choices' else choices' @ choices in
try
match (List.find (fun choice -> not (choice () = None)) choices) () with
Some cmd -> cmd
| None -> raise Not_found
with Not_found -> failwith (Printf.sprintf "Can't find tool: %s" cmd)
else
try let _ = search_in_path opt in opt
with Not_found -> cmd
let mk_virtual_solvers =
List.iter begin fun cmd ->
let solver () =
A (find_tool cmd)
in Command.setup_virtual_command_solver (String.uppercase_ascii cmd) solver
end
let () =
mk_virtual_solvers
["ocamlc"; "ocamlopt"; "ocamldep"; "ocamldoc";
"ocamlyacc"; "menhir"; "ocamllex"; "ocamlmklib"; "ocamlmktop"; "ocamlfind"]
let ocamlc = ref (V"OCAMLC")
let ocamlopt = ref (V"OCAMLOPT")
let ocamldep = ref (V"OCAMLDEP")
let ocamldoc = ref (V"OCAMLDOC")
let ocamlyacc = ref N
let ocamllex = ref (V"OCAMLLEX")
let ocamlmklib = ref (V"OCAMLMKLIB")
let ocamlmktop = ref (V"OCAMLMKTOP")
let ocamlrun = ref N
let ocamlfind_cmd = ref (V"OCAMLFIND")
let ocamlfind arg = S[!ocamlfind_cmd; arg]
let program_to_execute = ref false
let must_clean = ref false
let show_documentation = ref false
let recursive = ref false
let ext_lib = ref Ocamlbuild_config.a
let ext_obj = ref Ocamlbuild_config.o
let ext_dll =
let s = Ocamlbuild_config.ext_dll in
ref (String.sub s 1 (String.length s - 1))
let exe = ref Ocamlbuild_config.exe
let targets_internal = ref []
let ocaml_libs_internal = ref []
let ocaml_mods_internal = ref []
let ocaml_pkgs_internal = ref []
let ocaml_syntax = ref None
let ocaml_lflags_internal = ref []
let ocaml_cflags_internal = ref []
let ocaml_docflags_internal = ref []
let ocaml_ppflags_internal = ref []
let ocaml_yaccflags_internal = ref []
let ocaml_lexflags_internal = ref []
let program_args_internal = ref []
let ignore_list_internal = ref []
let tags_internal = ref [["quiet"]]
let tag_lines_internal = ref []
let show_tags_internal = ref []
let plugin_tags_internal = ref []
let log_file_internal = ref "_log"
let my_include_dirs = ref [[Filename.current_dir_name]]
let my_exclude_dirs = ref [[".svn"; "CVS"]]
let dummy = "*invalid-dummy-string*";; (* Dummy string for delimiting the latest argument *)
(* The JoCaml support will be in a plugin when the plugin system will support
* multiple/installed plugins *)
let use_jocaml () =
ocamlc := A "jocamlc";
ocamlopt := A "jocamlopt";
ocamldep := A "jocamldep";
ocamlyacc := A "jocamlyacc";
ocamllex := A "jocamllex";
ocamlmklib := A "jocamlmklib";
ocamlmktop := A "jocamlmktop";
ocamlrun := A "jocamlrun";
;;
let add_to rxs x =
let xs = Lexers.comma_or_blank_sep_strings
Const.Source.command_line (Lexing.from_string x) in
rxs := xs :: !rxs
let add_to' rxs x =
if x <> dummy then
rxs := [x] :: !rxs
else
()
let set_cmd rcmd = String (fun s -> rcmd := Sh s)
let set_build_dir s =
make_links := false;
if Filename.is_relative s then
build_dir := Filename.concat (Sys.getcwd ()) s
else
build_dir := s
let spec = ref (
Arg.align
[
"-version", Unit (fun () -> print_endline version; raise Exit_OK), " Display the version";
"-vnum", Unit (fun () -> print_endline Sys.ocaml_version; raise Exit_OK),
" Display the version number";
"-quiet", Unit (fun () -> Log.level := 0), " Make as quiet as possible";
"-verbose", Int (fun i -> Log.classic_display := true; Log.level := i + 2), "<level> Set the verbosity level";
"-documentation", Set show_documentation, " Show rules and flags";
"-log", Set_string log_file_internal, "<file> Set log file";
"-no-log", Unit (fun () -> log_file_internal := ""), " No log file";
"-clean", Set must_clean, " Remove build directory and other files, then exit";
"-r", Set recursive, " Traverse directories by default (true: traverse)";
"-I", String (add_to' my_include_dirs), "<path> Add to include directories";
"-Is", String (add_to my_include_dirs), "<path,...> (same as above, but accepts a (comma or blank)-separated list)";
"-X", String (add_to' my_exclude_dirs), "<path> Directory to ignore";
"-Xs", String (add_to my_exclude_dirs), "<path,...> (idem)";
"-lib", String (add_to' ocaml_libs_internal), "<flag> Link to this ocaml library";
"-libs", String (add_to ocaml_libs_internal), "<flag,...> (idem)";
"-mod", String (add_to' ocaml_mods_internal), "<module> Link to this ocaml module";
"-mods", String (add_to ocaml_mods_internal), "<module,...> (idem)";
"-pkg", String (add_to' ocaml_pkgs_internal), "<package> Link to this ocaml findlib package";
"-pkgs", String (add_to ocaml_pkgs_internal), "<package,...> (idem)";
"-package", String (add_to' ocaml_pkgs_internal), "<package> (idem)";
"-syntax", String (fun syntax -> ocaml_syntax := Some syntax), "<syntax> Specify syntax using ocamlfind";
"-lflag", String (add_to' ocaml_lflags_internal), "<flag> Add to ocamlc link flags";
"-lflags", String (add_to ocaml_lflags_internal), "<flag,...> (idem)";
"-cflag", String (add_to' ocaml_cflags_internal), "<flag> Add to ocamlc compile flags";
"-cflags", String (add_to ocaml_cflags_internal), "<flag,...> (idem)";
"-docflag", String (add_to' ocaml_docflags_internal), "<flag> Add to ocamldoc flags";
"-docflags", String (add_to ocaml_docflags_internal), "<flag,...> (idem)";
"-yaccflag", String (add_to' ocaml_yaccflags_internal), "<flag> Add to ocamlyacc flags";
"-yaccflags", String (add_to ocaml_yaccflags_internal), "<flag,...> (idem)";
"-lexflag", String (add_to' ocaml_lexflags_internal), "<flag> Add to ocamllex flags";
"-lexflags", String (add_to ocaml_lexflags_internal), "<flag,...> (idem)";
"-ppflag", String (add_to' ocaml_ppflags_internal), "<flag> Add to ocaml preprocessing flags";
"-pp", String (add_to ocaml_ppflags_internal), "<flag,...> (idem)";
"-tag", String (add_to' tags_internal), "<tag> Add to default tags";
"-tags", String (add_to tags_internal), "<tag,...> (idem)";
"-plugin-tag", String (add_to' plugin_tags_internal), "<tag> Use this tag when compiling the myocamlbuild.ml plugin";
"-plugin-tags", String (add_to plugin_tags_internal), "<tag,...> (idem)";
"-tag-line", String (add_to' tag_lines_internal), "<tag> Use this line of tags (as in _tags)";
"-show-tags", String (add_to' show_tags_internal), "<path> Show tags that applies on that pathname";
"-ignore", String (add_to ignore_list_internal), "<module,...> Don't try to build these modules";
"-no-links", Clear make_links, " Don't make links of produced final targets";
"-no-skip", Clear ignore_auto, " Don't skip modules that are requested by ocamldep but cannot be built";
"-no-hygiene", Clear hygiene, " Don't apply sanity-check rules";
"-no-plugin", Clear plugin, " Don't build myocamlbuild.ml";
"-no-stdlib", Set nostdlib, " Don't ignore stdlib modules";
"-dont-catch-errors", Clear catch_errors, " Don't catch and display exceptions (useful to display the call stack)";
"-just-plugin", Set just_plugin, " Just build myocamlbuild.ml";
"-byte-plugin", Clear native_plugin, " Don't use a native plugin but bytecode";
"-plugin-option", String ignore, " Use the option only when plugin is run";
"-sanitization-script", Set_string sanitization_script, " Change the file name for the generated sanitization script";
"-no-sanitize", Clear sanitize, " Do not generate sanitization script";
"-nothing-should-be-rebuilt", Set nothing_should_be_rebuilt, " Fail if something needs to be rebuilt";
"-classic-display", Set Log.classic_display, " Display executed commands the old-fashioned way";
"-use-menhir", Set use_menhir, " Use menhir instead of ocamlyacc";
"-use-jocaml", Unit use_jocaml, " Use jocaml compilers instead of ocaml ones";
"-use-ocamlfind", Set use_ocamlfind, " Use the 'ocamlfind' wrapper instead of \
using Findlib directly to determine command-line arguments. \
Use -no-ocamlfind to disable.";
"-no-ocamlfind", Clear use_ocamlfind, " Don't use ocamlfind.";
"-j", Set_int Command.jobs, "<N> Allow N jobs at once (0 for unlimited)";
"-build-dir", String set_build_dir, "<path> Set build directory (implies no-links)";
"-install-lib-dir", Set_string Ocamlbuild_where.libdir, "<path> Set the install library directory";
"-install-bin-dir", Set_string Ocamlbuild_where.bindir, "<path> Set the install binary directory";
"-where", Unit (fun () -> print_endline !Ocamlbuild_where.libdir; raise Exit_OK), " Display the install library directory";
"-which", String (fun cmd -> print_endline (find_tool cmd); raise Exit_OK), "<command> Display path to the tool command";
"-ocamlc", set_cmd ocamlc, "<command> Set the OCaml bytecode compiler";
"-ocamlopt", set_cmd ocamlopt, "<command> Set the OCaml native compiler";
"-ocamldep", set_cmd ocamldep, "<command> Set the OCaml dependency tool";
"-ocamldoc", set_cmd ocamldoc, "<command> Set the OCaml documentation generator";
"-ocamlyacc", set_cmd ocamlyacc, "<command> Set the ocamlyacc tool";
"-menhir", set_cmd ocamlyacc, "<command> Set the menhir tool (use it after -use-menhir)";
"-ocamllex", set_cmd ocamllex, "<command> Set the ocamllex tool";
"-ocamlmklib", set_cmd ocamlmklib, "<command> Set the ocamlmklib tool";
"-ocamlmktop", set_cmd ocamlmktop, "<command> Set the ocamlmktop tool";
"-ocamlrun", set_cmd ocamlrun, "<command> Set the ocamlrun tool";
"--", Rest (fun x -> program_to_execute := true; add_to' program_args_internal x),
" Stop argument processing, remaining arguments are given to the user program";
])
let add x =
spec := !spec @ [x]
let targets = ref []
let ocaml_libs = ref []
let ocaml_mods = ref []
let ocaml_pkgs = ref []
let ocaml_lflags = ref []
let ocaml_cflags = ref []
let ocaml_ppflags = ref []
let ocaml_docflags = ref []
let ocaml_yaccflags = ref []
let ocaml_lexflags = ref []
let program_args = ref []
let ignore_list = ref []
let tags = ref []
let tag_lines = ref []
let show_tags = ref []
let plugin_tags = ref []
let init () =
let anon_fun = add_to' targets_internal in
let usage_msg = sprintf "Usage %s [options] <target>" Sys.argv.(0) in
let argv' = Array.concat [Sys.argv; [|dummy|]] in
parse_argv argv' !spec anon_fun usage_msg;
Shell.mkdir_p !build_dir;
project_root_dir := Some (Sys.getcwd ());
let () =
let log = !log_file_internal in
if log = "" then Log.init None
else if not (Filename.is_implicit log) then
failwith
(sprintf "Bad log file name: the file name must be implicit (not %S)" log)
else
let log = filename_concat !build_dir log in
Shell.mkdir_p (Filename.dirname log);
Shell.rm_f log;
let log = if !Log.level > 0 then Some log else None in
Log.init log
in
if !use_ocamlfind then begin
begin try ignore(Command.search_in_path "ocamlfind")
with Not_found ->
failwith "ocamlfind not found on path, but -no-ocamlfind not used"
end;
let with_ocamlfind (command_name, command_ref) =
command_ref := match !command_ref with
| Sh user_command ->
(* this command has been set by the user
using an -ocamlc, -ocamlopt, etc. flag;
not all such combinations make sense (eg. "ocamlfind
/my/special/path/to/ocamlc" will make ocamlfind choke),
but the user will see the error and hopefully fix the
flags. *)
ocamlfind & (Sh user_command);
| _ -> ocamlfind & A command_name
in
(* Note that plugins can still modify these variables After_options.
This design decision can easily be changed. *)
List.iter with_ocamlfind [
"ocamlc", ocamlc;
"ocamlopt", ocamlopt;
"ocamldep", ocamldep;
"ocamldoc", ocamldoc;
"ocamlmklib", ocamlmklib;
"ocamlmktop", ocamlmktop;
]
end;
let reorder x y = x := !x @ (List.concat (List.rev !y)) in
reorder targets targets_internal;
reorder ocaml_libs ocaml_libs_internal;
reorder ocaml_mods ocaml_mods_internal;
reorder ocaml_pkgs ocaml_pkgs_internal;
reorder ocaml_cflags ocaml_cflags_internal;
reorder ocaml_lflags ocaml_lflags_internal;
reorder ocaml_ppflags ocaml_ppflags_internal;
reorder ocaml_docflags ocaml_docflags_internal;
reorder ocaml_yaccflags ocaml_yaccflags_internal;
reorder ocaml_lexflags ocaml_lexflags_internal;
reorder program_args program_args_internal;
reorder tags tags_internal;
reorder tag_lines tag_lines_internal;
reorder ignore_list ignore_list_internal;
reorder show_tags show_tags_internal;
reorder plugin_tags plugin_tags_internal;
let check_dir dir =
if Filename.is_implicit dir then
sys_file_exists dir
else
failwith
(sprintf "Included or excluded directories must be implicit (not %S)" dir)
in
let dir_reorder my dir =
let d = !dir in
reorder dir my;
dir := List.filter check_dir (!dir @ d)
in
dir_reorder my_include_dirs include_dirs;
dir_reorder my_exclude_dirs exclude_dirs;
ignore_list := List.map String.capitalize_ascii !ignore_list
;;
(* The current heuristic: we know we are in an ocamlbuild project if
either _tags or myocamlbuild.ml are present at the root. This
heuristic has been documented and explained to users, so it should
not be changed. *)
let ocamlbuild_project_heuristic () =
let root_dir = match !project_root_dir with
| None -> Sys.getcwd ()
| Some dir -> dir in
let at_root file = Filename.concat root_dir file in
Sys.file_exists (* authorized since we're not in build *)
(at_root "_tags")
|| Sys.file_exists (* authorized since we're not in build *)
(at_root "myocamlbuild.ml")

35
ocamlbuild/options.mli
View File

@ -1,35 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
include Signatures.OPTIONS with type command_spec = Command.spec
(* This option is not in Signatures.OPTIONS yet because adding tags to
the compilation of the plugin is a recent feature that may still be
subject to change, so the interface may not be stable; besides,
there is obviously little to gain from tweaking that option from
inside the plugin itself... *)
val plugin_tags : string list ref
(* Returns 'true' if we heuristically infer that we are run from an
ocamlbuild projet (either _tags or myocamlbuild.ml are present).
This information is used to decide whether to enable recursive
traversal of subdirectories by default.
*)
val ocamlbuild_project_heuristic : unit -> bool
val entry : bool Slurp.entry option ref
val init : unit -> unit

63
ocamlbuild/param_tags.ml
View File

@ -1,63 +0,0 @@
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
open My_std
(* Original author: Romain Bardou *)
module StringSet = Set.Make(String)
(* tag name -> tag action (string -> unit) *)
let declared_tags = Hashtbl.create 17
let acknowledged_tags = ref []
let only_once f =
let instances = ref StringSet.empty in
fun param ->
if StringSet.mem param !instances then ()
else begin
instances := StringSet.add param !instances;
f param
end
let declare name action =
Hashtbl.add declared_tags name (only_once action)
let parse source tag = Lexers.tag_gen source (lexbuf_of_string tag)
let acknowledge source maybe_loc tag =
acknowledged_tags := (parse source tag, maybe_loc) :: !acknowledged_tags
let really_acknowledge ?(quiet=false) ((name, param), maybe_loc) =
match param with
| None ->
if Hashtbl.mem declared_tags name && not quiet then
Log.eprintf "%aWarning: tag %S expects a parameter"
Loc.print_loc_option maybe_loc name
| Some param ->
let actions = List.rev (Hashtbl.find_all declared_tags name) in
if actions = [] && not quiet then
Log.eprintf "%aWarning: tag %S does not expect a parameter, \
but is used with parameter %S"
Loc.print_loc_option maybe_loc name param;
List.iter (fun f -> f param) actions
let partial_init ?quiet source tags =
let parse_noloc tag = (parse source tag, None) in
Tags.iter (fun tag -> really_acknowledge ?quiet (parse_noloc tag)) tags
let init () =
List.iter really_acknowledge (My_std.List.ordered_unique !acknowledged_tags)
let make = Printf.sprintf "%s(%s)"

Some files were not shown because too many files have changed in this diff Show More