Parallel build
This commit is contained in:
Nathanaël Courant
parent
30ba83b6f4
commit
92037d7271
8
Makefile
8
Makefile
@ -96,6 +96,7 @@ $(BOOT)/stdlib: $(OCAMLSRC)/stdlib $(CONFIG) $(GENERATED) patches/compflags.patc
|
|||||||
awk -f $(BOOT)/stdlib/expand_module_aliases.awk < $(BOOT)/stdlib/stdlib.mli > $(BOOT)/stdlib/stdlib.pp.mli
|
awk -f $(BOOT)/stdlib/expand_module_aliases.awk < $(BOOT)/stdlib/stdlib.mli > $(BOOT)/stdlib/stdlib.pp.mli
|
||||||
awk -f $(BOOT)/stdlib/expand_module_aliases.awk < $(BOOT)/stdlib/stdlib.ml > $(BOOT)/stdlib/stdlib.pp.ml
|
awk -f $(BOOT)/stdlib/expand_module_aliases.awk < $(BOOT)/stdlib/stdlib.ml > $(BOOT)/stdlib/stdlib.pp.ml
|
||||||
cp $(OCAMLSRC)/asmrun/libasmrun.a $(BOOT)/stdlib/
|
cp $(OCAMLSRC)/asmrun/libasmrun.a $(BOOT)/stdlib/
|
||||||
|
cp Makefile.stdlib $(BOOT)/stdlib/Makefile
|
||||||
|
|
||||||
COPY_TARGETS=\
|
COPY_TARGETS=\
|
||||||
$(BOOT)/bytecomp \
|
$(BOOT)/bytecomp \
|
||||||
@ -108,6 +109,7 @@ COPY_TARGETS=\
|
|||||||
|
|
||||||
.PHONY: copy
|
.PHONY: copy
|
||||||
copy: $(COPY_TARGETS)
|
copy: $(COPY_TARGETS)
|
||||||
|
cp Makefile.ocamlc $(BOOT)/Makefile
|
||||||
|
|
||||||
.PHONY: ocamlrun
|
.PHONY: ocamlrun
|
||||||
ocamlrun: $(OCAMLRUN)
|
ocamlrun: $(OCAMLRUN)
|
||||||
@ -115,9 +117,11 @@ ocamlrun: $(OCAMLRUN)
|
|||||||
$(BOOT)/ocamlc: $(COPY_TARGETS)
|
$(BOOT)/ocamlc: $(COPY_TARGETS)
|
||||||
make -C $(OCAMLSRC)/yacc all
|
make -C $(OCAMLSRC)/yacc all
|
||||||
make -C miniml/interp interpopt.opt
|
make -C miniml/interp interpopt.opt
|
||||||
cd $(BOOT)/stdlib && ../../timed.sh ../../compile_stdlib.sh
|
./timed.sh make -C _boot/stdlib all
|
||||||
|
# cd $(BOOT)/stdlib && ../../timed.sh ../../compile_stdlib.sh
|
||||||
mkdir -p $(BOOT)/compilerlibs
|
mkdir -p $(BOOT)/compilerlibs
|
||||||
cd $(BOOT) && ../timed.sh ../compile_ocamlc.sh
|
./timed.sh make -C _boot all
|
||||||
|
# cd $(BOOT) && ../timed.sh ../compile_ocamlc.sh
|
||||||
|
|
||||||
.PHONY: test-compiler
|
.PHONY: test-compiler
|
||||||
test-compiler: $(OCAMLRUN)
|
test-compiler: $(OCAMLRUN)
|
||||||
|
|||||||
120
Makefile.ocamlc
Normal file
120
Makefile.ocamlc
Normal file
@ -0,0 +1,120 @@
|
|||||||
|
#**************************************************************************
|
||||||
|
#* *
|
||||||
|
#* OCaml *
|
||||||
|
#* *
|
||||||
|
#* Xavier Leroy, projet Cristal, INRIA Rocquencourt *
|
||||||
|
#* *
|
||||||
|
#* Copyright 1999 Institut National de Recherche en Informatique et *
|
||||||
|
#* en Automatique. *
|
||||||
|
#* *
|
||||||
|
#* All rights reserved. This file is distributed under the terms of *
|
||||||
|
#* the GNU Lesser General Public License version 2.1, with the *
|
||||||
|
#* special exception on linking described in the file LICENSE. *
|
||||||
|
#* *
|
||||||
|
#**************************************************************************
|
||||||
|
|
||||||
|
COMPILER=../miniml/interp/interp.opt -g -nostdlib -I stdlib
|
||||||
|
INCLUDES=-I utils -I parsing -I typing -I bytecomp -I driver
|
||||||
|
|
||||||
|
COMPFLAGS=-strict-sequence -principal -absname -w +a-4-9-41-42-44-45-48 \
|
||||||
|
-warn-error A \
|
||||||
|
-bin-annot -safe-string -strict-formats $(INCLUDES)
|
||||||
|
LINKFLAGS=
|
||||||
|
|
||||||
|
DEPEND=../miniml/interp/depend.sh
|
||||||
|
DEPFLAGS=$(INCLUDES)
|
||||||
|
|
||||||
|
UTILS=utils/config.cmx utils/misc.cmx \
|
||||||
|
utils/identifiable.cmx utils/numbers.cmx utils/arg_helper.cmx \
|
||||||
|
utils/clflags.cmx utils/tbl.cmx utils/profile.cmx \
|
||||||
|
utils/terminfo.cmx utils/ccomp.cmx utils/warnings.cmx \
|
||||||
|
utils/consistbl.cmx \
|
||||||
|
utils/strongly_connected_components.cmx \
|
||||||
|
utils/build_path_prefix_map.cmx \
|
||||||
|
utils/targetint.cmx
|
||||||
|
|
||||||
|
PARSING=parsing/location.cmx parsing/longident.cmx \
|
||||||
|
parsing/docstrings.cmx parsing/syntaxerr.cmx \
|
||||||
|
parsing/ast_helper.cmx parsing/parser.cmx \
|
||||||
|
parsing/lexer.cmx parsing/parse.cmx parsing/printast.cmx \
|
||||||
|
parsing/pprintast.cmx \
|
||||||
|
parsing/ast_mapper.cmx parsing/ast_iterator.cmx parsing/attr_helper.cmx \
|
||||||
|
parsing/builtin_attributes.cmx parsing/ast_invariants.cmx parsing/depend.cmx
|
||||||
|
|
||||||
|
TYPING=typing/ident.cmx typing/path.cmx \
|
||||||
|
typing/primitive.cmx typing/types.cmx \
|
||||||
|
typing/btype.cmx typing/oprint.cmx \
|
||||||
|
typing/subst.cmx typing/predef.cmx \
|
||||||
|
typing/datarepr.cmx typing/cmi_format.cmx typing/env.cmx \
|
||||||
|
typing/typedtree.cmx typing/printtyped.cmx typing/ctype.cmx \
|
||||||
|
typing/printtyp.cmx typing/includeclass.cmx \
|
||||||
|
typing/mtype.cmx typing/envaux.cmx typing/includecore.cmx \
|
||||||
|
typing/typedtreeIter.cmx typing/typedtreeMap.cmx \
|
||||||
|
typing/tast_mapper.cmx \
|
||||||
|
typing/cmt_format.cmx typing/untypeast.cmx \
|
||||||
|
typing/includemod.cmx typing/typetexp.cmx typing/printpat.cmx \
|
||||||
|
typing/parmatch.cmx typing/stypes.cmx typing/typedecl.cmx typing/typeopt.cmx \
|
||||||
|
typing/typecore.cmx typing/typeclass.cmx typing/typemod.cmx
|
||||||
|
|
||||||
|
COMP=bytecomp/lambda.cmx bytecomp/printlambda.cmx \
|
||||||
|
bytecomp/semantics_of_primitives.cmx \
|
||||||
|
bytecomp/switch.cmx bytecomp/matching.cmx \
|
||||||
|
bytecomp/translobj.cmx bytecomp/translattribute.cmx \
|
||||||
|
bytecomp/translprim.cmx bytecomp/translcore.cmx \
|
||||||
|
bytecomp/translclass.cmx bytecomp/translmod.cmx \
|
||||||
|
bytecomp/simplif.cmx bytecomp/runtimedef.cmx \
|
||||||
|
bytecomp/meta.cmx bytecomp/opcodes.cmx \
|
||||||
|
bytecomp/bytesections.cmx bytecomp/dll.cmx \
|
||||||
|
bytecomp/symtable.cmx \
|
||||||
|
driver/pparse.cmx driver/main_args.cmx \
|
||||||
|
driver/compenv.cmx driver/compmisc.cmx \
|
||||||
|
driver/compdynlink.cmx driver/compplugin.cmx driver/makedepend.cmx
|
||||||
|
|
||||||
|
COMMON=$(UTILS) $(PARSING) $(TYPING) $(COMP)
|
||||||
|
|
||||||
|
BYTECOMP=bytecomp/instruct.cmx bytecomp/bytegen.cmx \
|
||||||
|
bytecomp/printinstr.cmx bytecomp/emitcode.cmx \
|
||||||
|
bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx bytecomp/bytepackager.cmx \
|
||||||
|
driver/errors.cmx driver/compile.cmx
|
||||||
|
|
||||||
|
BYTESTART=driver/main.cmx
|
||||||
|
|
||||||
|
all: ocamlc
|
||||||
|
|
||||||
|
# Shared parts of the system compiled with the native-code compiler
|
||||||
|
|
||||||
|
compilerlibs/ocamlcommon.cmxa: $(COMMON)
|
||||||
|
$(COMPILER) -a -linkall -o $@ $^
|
||||||
|
|
||||||
|
# The bytecode compiler compiled with the native-code compiler
|
||||||
|
|
||||||
|
compilerlibs/ocamlbytecomp.cmxa: $(BYTECOMP)
|
||||||
|
$(COMPILER) -a -o $@ $^
|
||||||
|
|
||||||
|
ocamlc: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \
|
||||||
|
$(BYTESTART)
|
||||||
|
$(COMPILER) $(LINKFLAGS) -o $@ $^ -cclib "$(BYTECCLIBS)"
|
||||||
|
|
||||||
|
# Compiler Plugins
|
||||||
|
|
||||||
|
driver/compdynlink.cmx: driver/compdynlink.mlno driver/compdynlink.cmi
|
||||||
|
$(COMPILER) $(COMPFLAGS) -c -impl $<
|
||||||
|
|
||||||
|
# Default rules
|
||||||
|
|
||||||
|
.SUFFIXES: .ml .mli .cmi .cmx
|
||||||
|
|
||||||
|
.mli.cmi:
|
||||||
|
$(COMPILER) $(COMPFLAGS) -c $<
|
||||||
|
|
||||||
|
.ml.cmx:
|
||||||
|
$(COMPILER) $(COMPFLAGS) -c $<
|
||||||
|
|
||||||
|
.PHONY: depend
|
||||||
|
depend:
|
||||||
|
(for d in utils parsing typing bytecomp driver; \
|
||||||
|
do $(DEPEND) $(DEPFLAGS) $$d/*.mli $$d/*.ml || exit; \
|
||||||
|
done) > .depend
|
||||||
|
$(DEPEND) $(DEPFLAGS) -impl driver/compdynlink.mlno >> .depend
|
||||||
|
|
||||||
|
include .depend
|
||||||
98
Makefile.stdlib
Normal file
98
Makefile.stdlib
Normal file
@ -0,0 +1,98 @@
|
|||||||
|
#**************************************************************************
|
||||||
|
#* *
|
||||||
|
#* OCaml *
|
||||||
|
#* *
|
||||||
|
#* Xavier Leroy, projet Cristal, INRIA Rocquencourt *
|
||||||
|
#* *
|
||||||
|
#* Copyright 1999 Institut National de Recherche en Informatique et *
|
||||||
|
#* en Automatique. *
|
||||||
|
#* *
|
||||||
|
#* All rights reserved. This file is distributed under the terms of *
|
||||||
|
#* the GNU Lesser General Public License version 2.1, with the *
|
||||||
|
#* special exception on linking described in the file LICENSE. *
|
||||||
|
#* *
|
||||||
|
#**************************************************************************
|
||||||
|
|
||||||
|
CAMLRUN = ../../ocaml-src/byterun/ocamlrun
|
||||||
|
TARGET_BINDIR ?= $(BINDIR)
|
||||||
|
|
||||||
|
COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48 \
|
||||||
|
-g -warn-error A -bin-annot -nostdlib \
|
||||||
|
-safe-string -strict-formats
|
||||||
|
COMPILER=../../miniml/interp/interp.opt
|
||||||
|
DEPEND=../../miniml/interp/depend.sh -native
|
||||||
|
|
||||||
|
# Object file prefix
|
||||||
|
P=stdlib__
|
||||||
|
|
||||||
|
OBJS=camlinternalFormatBasics.cmx stdlib.cmx $(OTHERS)
|
||||||
|
OTHERS=$(P)seq.cmx $(P)char.cmx $(P)uchar.cmx $(P)sys.cmx $(P)list.cmx \
|
||||||
|
$(P)bytes.cmx $(P)string.cmx \
|
||||||
|
$(P)sort.cmx $(P)marshal.cmx $(P)obj.cmx $(P)float.cmx $(P)array.cmx \
|
||||||
|
$(P)int32.cmx $(P)int64.cmx $(P)nativeint.cmx \
|
||||||
|
$(P)lexing.cmx $(P)parsing.cmx \
|
||||||
|
$(P)set.cmx $(P)map.cmx $(P)stack.cmx $(P)queue.cmx \
|
||||||
|
camlinternalLazy.cmx $(P)lazy.cmx $(P)stream.cmx \
|
||||||
|
$(P)buffer.cmx camlinternalFormat.cmx $(P)printf.cmx \
|
||||||
|
$(P)arg.cmx $(P)printexc.cmx $(P)gc.cmx \
|
||||||
|
$(P)digest.cmx $(P)random.cmx $(P)hashtbl.cmx $(P)weak.cmx \
|
||||||
|
$(P)format.cmx $(P)scanf.cmx $(P)callback.cmx \
|
||||||
|
camlinternalOO.cmx $(P)oo.cmx camlinternalMod.cmx \
|
||||||
|
$(P)genlex.cmx $(P)ephemeron.cmx \
|
||||||
|
$(P)filename.cmx $(P)complex.cmx \
|
||||||
|
$(P)arrayLabels.cmx $(P)listLabels.cmx $(P)bytesLabels.cmx \
|
||||||
|
$(P)stringLabels.cmx $(P)moreLabels.cmx $(P)stdLabels.cmx \
|
||||||
|
$(P)spacetime.cmx $(P)bigarray.cmx
|
||||||
|
|
||||||
|
PREFIXED_OBJS=$(filter stdlib__%.cmx,$(OBJS))
|
||||||
|
|
||||||
|
all: stdlib.cmxa std_exit.cmx
|
||||||
|
|
||||||
|
stdlib.cmxa: $(OBJS)
|
||||||
|
$(COMPILER) -a -o $@ $^
|
||||||
|
|
||||||
|
.SUFFIXES: .mli .ml .cmi .cmx
|
||||||
|
|
||||||
|
stdlib.cmi: stdlib.pp.mli
|
||||||
|
$(COMPILER) $(COMPFLAGS) $(shell ./Compflags $@) -o $@ -c $<
|
||||||
|
|
||||||
|
stdlib.cmx: stdlib.pp.ml
|
||||||
|
$(COMPILER) $(COMPFLAGS) $(shell ./Compflags $@) -o $@ -c $<
|
||||||
|
|
||||||
|
%.cmi: %.mli
|
||||||
|
$(COMPILER) $(COMPFLAGS) $(shell ./Compflags $@) -c $<
|
||||||
|
|
||||||
|
stdlib__%.cmi: %.mli
|
||||||
|
$(COMPILER) $(COMPFLAGS) $(shell ./Compflags $@) -o $@ -c $<
|
||||||
|
|
||||||
|
%.cmx: %.ml
|
||||||
|
$(COMPILER) $(COMPFLAGS) $(shell ./Compflags $@) -c $<
|
||||||
|
|
||||||
|
stdlib__%.cmx: %.ml
|
||||||
|
$(COMPILER) $(COMPFLAGS) $(shell ./Compflags $@) -o $@ -c $<
|
||||||
|
|
||||||
|
|
||||||
|
# Dependencies on Stdlib (not tracked by ocamldep)
|
||||||
|
$(OTHERS:.cmx=.cmi) std_exit.cmi: stdlib.cmi
|
||||||
|
$(OBJS) std_exit.cmx: stdlib.cmi
|
||||||
|
$(OTHERS) std_exit.cmx: stdlib.cmx
|
||||||
|
|
||||||
|
clean::
|
||||||
|
rm -f *.cm* *.o *.a
|
||||||
|
rm -f *~
|
||||||
|
|
||||||
|
include .depend
|
||||||
|
|
||||||
|
EMPTY :=
|
||||||
|
SPACE := $(EMPTY) $(EMPTY)
|
||||||
|
|
||||||
|
.PHONY: depend
|
||||||
|
depend:
|
||||||
|
$(DEPEND) $(filter-out stdlib.%,$(wildcard *.mli *.ml)) \
|
||||||
|
> .depend.tmp
|
||||||
|
echo "stdlib.cmi : camlinternalFormatBasics.cmi" >> .depend.tmp
|
||||||
|
echo "stdlib.cmx : camlinternalFormatBasics.cmx" >> .depend.tmp
|
||||||
|
sed -Ee \
|
||||||
|
's#(^| )(${subst ${SPACE},|,${PREFIXED_OBJS:stdlib__%.cmx=%}})[.]#\1stdlib__\2.#g' \
|
||||||
|
.depend.tmp > .depend
|
||||||
|
rm -f .depend.tmp
|
||||||
@ -7,9 +7,11 @@ OCAMLLEX=../../ocaml-src/byterun/ocamlrun ../../ocaml-src/boot/ocamllex
|
|||||||
OCAMLYACC=../../ocaml-src/yacc/ocamlyacc
|
OCAMLYACC=../../ocaml-src/yacc/ocamlyacc
|
||||||
|
|
||||||
COMMONOBJS=int32.ml int64.ml nativeint.ml seq.ml char.ml bytes.ml string.ml digest.ml marshal.ml array.ml list.ml stack.ml hashtbl.ml map.ml set.ml buffer.ml format.ml printf.ml arg.ml gc.ml filename.ml lexing.ml parsing.ml
|
COMMONOBJS=int32.ml int64.ml nativeint.ml seq.ml char.ml bytes.ml string.ml digest.ml marshal.ml array.ml list.ml stack.ml hashtbl.ml map.ml set.ml buffer.ml format.ml printf.ml arg.ml gc.ml filename.ml lexing.ml parsing.ml
|
||||||
INTERPOBJS=$(COMMONOBJS) misc.ml clflags.ml location.ml asttypes.mli warnings.ml syntaxerr.ml longident.ml parsetree.mli docstrings.ml ast_helper.ml parser.ml lexer.ml parse.ml ../../interpreter/conf.ml ../../interpreter/data.ml ../../interpreter/envir.ml ../../interpreter/runtime_lib.ml ../../interpreter/runtime_base.ml ../../interpreter/eval.ml ../../interpreter/runtime_stdlib.ml ../../interpreter/runtime_compiler.ml ../../interpreter/primitives.ml ../../interpreter/interp.ml
|
PARSEOBJS=misc.ml clflags.ml location.ml asttypes.mli warnings.ml syntaxerr.ml longident.ml parsetree.mli docstrings.ml ast_helper.ml parser.ml lexer.ml parse.ml
|
||||||
|
INTERPOBJS=$(COMMONOBJS) $(PARSEOBJS) ../../interpreter/conf.ml ../../interpreter/data.ml ../../interpreter/envir.ml ../../interpreter/runtime_lib.ml ../../interpreter/runtime_base.ml ../../interpreter/eval.ml ../../interpreter/runtime_stdlib.ml ../../interpreter/runtime_compiler.ml ../../interpreter/primitives.ml ../../interpreter/interp.ml
|
||||||
LEXOBJS1=../../ocaml-src/lex/cset.ml ../../ocaml-src/lex/syntax.ml ../../ocaml-src/lex/parser.ml
|
LEXOBJS1=../../ocaml-src/lex/cset.ml ../../ocaml-src/lex/syntax.ml ../../ocaml-src/lex/parser.ml
|
||||||
LEXOBJS2=../../ocaml-src/lex/table.ml ../../ocaml-src/lex/lexgen.ml ../../ocaml-src/lex/compact.ml ../../ocaml-src/lex/common.ml ../../ocaml-src/lex/output.ml ../../ocaml-src/lex/outputbis.ml ../../ocaml-src/lex/main.ml
|
LEXOBJS2=../../ocaml-src/lex/table.ml ../../ocaml-src/lex/lexgen.ml ../../ocaml-src/lex/compact.ml ../../ocaml-src/lex/common.ml ../../ocaml-src/lex/output.ml ../../ocaml-src/lex/outputbis.ml ../../ocaml-src/lex/main.ml
|
||||||
|
DEPENDOBJS=$(COMMONOBJS) $(PARSEOBJS) depend.ml makedepend.ml
|
||||||
|
|
||||||
LEXBOOTOBJS=$(COMMONOBJS) $(LEXOBJS1) ../../lex/lexer.ml $(LEXOBJS2)
|
LEXBOOTOBJS=$(COMMONOBJS) $(LEXOBJS1) ../../lex/lexer.ml $(LEXOBJS2)
|
||||||
LEXOBJS=$(COMMONOBJS) $(LEXOBJS1) lex/lexer.ml $(LEXOBJS2)
|
LEXOBJS=$(COMMONOBJS) $(LEXOBJS1) lex/lexer.ml $(LEXOBJS2)
|
||||||
@ -41,6 +43,9 @@ cvt_emit.byte: $(COMMONOBJS) cvt_emit.ml
|
|||||||
interp.byte: $(INTERPOBJS)
|
interp.byte: $(INTERPOBJS)
|
||||||
$(MINIML) $(INTERPOBJS) -o $@
|
$(MINIML) $(INTERPOBJS) -o $@
|
||||||
|
|
||||||
|
makedepend.byte: $(DEPENDOBJS)
|
||||||
|
$(MINIML) $(DEPENDOBJS) -o $@
|
||||||
|
|
||||||
interpopt.opt: $(INTERPOBJS) interp.byte
|
interpopt.opt: $(INTERPOBJS) interp.byte
|
||||||
./genfileopt.sh
|
./genfileopt.sh
|
||||||
@echo "Compiling interpopt.opt, this make take a while..."
|
@echo "Compiling interpopt.opt, this make take a while..."
|
||||||
|
|||||||
@ -1,2 +1,3 @@
|
|||||||
let fast = ref false
|
let fast = ref false
|
||||||
let applicative_functors = ref true
|
let applicative_functors = ref true
|
||||||
|
let transparent_modules = ref false
|
||||||
|
|||||||
514
miniml/interp/depend.ml
Normal file
514
miniml/interp/depend.ml
Normal file
@ -0,0 +1,514 @@
|
|||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* OCaml *)
|
||||||
|
(* *)
|
||||||
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 1999 Institut National de Recherche en Informatique et *)
|
||||||
|
(* en Automatique. *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of *)
|
||||||
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||||
|
(* special exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
open Asttypes
|
||||||
|
open Location
|
||||||
|
open Longident
|
||||||
|
open Parsetree
|
||||||
|
|
||||||
|
let pp_deps = ref []
|
||||||
|
|
||||||
|
module StringSet = Set.Make(struct type t = string let compare = compare end)
|
||||||
|
module StringMap = Map.Make(String)
|
||||||
|
|
||||||
|
(* Module resolution map *)
|
||||||
|
(* Node (set of imports for this path, map for submodules) *)
|
||||||
|
type map_tree = Node of StringSet.t * bound_map
|
||||||
|
and bound_map = map_tree StringMap.t
|
||||||
|
let bound = Node (StringSet.empty, StringMap.empty)
|
||||||
|
|
||||||
|
(*let get_free (Node (s, _m)) = s*)
|
||||||
|
let get_map (Node (_s, m)) = m
|
||||||
|
let make_leaf s = Node (StringSet.singleton s, StringMap.empty)
|
||||||
|
let make_node m = Node (StringSet.empty, m)
|
||||||
|
let rec weaken_map s (Node(s0,m0)) =
|
||||||
|
Node (StringSet.union s s0, StringMap.map (weaken_map s) m0)
|
||||||
|
let rec collect_free (Node (s, m)) =
|
||||||
|
StringMap.fold (fun _ n -> StringSet.union (collect_free n)) m s
|
||||||
|
|
||||||
|
(* Returns the imports required to access the structure at path p *)
|
||||||
|
(* Only raises Not_found if the head of p is not in the toplevel map *)
|
||||||
|
let rec lookup_free p m =
|
||||||
|
match p with
|
||||||
|
[] -> raise Not_found
|
||||||
|
| s::p ->
|
||||||
|
let Node (f, m') = StringMap.find s m in
|
||||||
|
try lookup_free p m' with Not_found -> f
|
||||||
|
|
||||||
|
(* Returns the node corresponding to the structure at path p *)
|
||||||
|
let rec lookup_map lid m =
|
||||||
|
match lid with
|
||||||
|
Lident s -> StringMap.find s m
|
||||||
|
| Ldot (l, s) -> StringMap.find s (get_map (lookup_map l m))
|
||||||
|
| Lapply _ -> raise Not_found
|
||||||
|
|
||||||
|
(* Collect free module identifiers in the a.s.t. *)
|
||||||
|
|
||||||
|
let free_structure_names = ref StringSet.empty
|
||||||
|
|
||||||
|
let add_names s =
|
||||||
|
free_structure_names := StringSet.union s !free_structure_names
|
||||||
|
|
||||||
|
let rec add_path bv ?(p=[]) = function
|
||||||
|
| Lident s ->
|
||||||
|
let free =
|
||||||
|
try lookup_free (s::p) bv with Not_found -> StringSet.singleton s
|
||||||
|
in
|
||||||
|
(*StringSet.iter (fun s -> Printf.eprintf "%s " s) free;
|
||||||
|
prerr_endline "";*)
|
||||||
|
add_names free
|
||||||
|
| Ldot(l, s) -> add_path bv ~p:(s::p) l
|
||||||
|
| Lapply(l1, l2) -> add_path bv l1; add_path bv l2
|
||||||
|
|
||||||
|
let open_module bv lid =
|
||||||
|
match lookup_map lid bv with
|
||||||
|
| Node (s, m) ->
|
||||||
|
add_names s;
|
||||||
|
StringMap.fold StringMap.add m bv
|
||||||
|
| exception Not_found ->
|
||||||
|
add_path bv lid; bv
|
||||||
|
|
||||||
|
let add_parent bv lid =
|
||||||
|
match lid.txt with
|
||||||
|
Ldot(l, _s) -> add_path bv l
|
||||||
|
| _ -> ()
|
||||||
|
|
||||||
|
let add = add_parent
|
||||||
|
|
||||||
|
let add_module_path bv lid = add_path bv lid.txt
|
||||||
|
|
||||||
|
let handle_extension ext = ()
|
||||||
|
|
||||||
|
let rec add_type bv ty =
|
||||||
|
match ty.ptyp_desc with
|
||||||
|
Ptyp_any -> ()
|
||||||
|
| Ptyp_var _ -> ()
|
||||||
|
| Ptyp_arrow(_, t1, t2) -> add_type bv t1; add_type bv t2
|
||||||
|
| Ptyp_tuple tl -> List.iter (add_type bv) tl
|
||||||
|
| Ptyp_constr(c, tl) -> add bv c; List.iter (add_type bv) tl
|
||||||
|
| Ptyp_object (fl, _) ->
|
||||||
|
List.iter
|
||||||
|
(function Otag (_, _, t) -> add_type bv t
|
||||||
|
| Oinherit t -> add_type bv t) fl
|
||||||
|
| Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
|
||||||
|
| Ptyp_alias(t, _) -> add_type bv t
|
||||||
|
| Ptyp_variant(fl, _, _) ->
|
||||||
|
List.iter
|
||||||
|
(function Rtag(_,_,_,stl) -> List.iter (add_type bv) stl
|
||||||
|
| Rinherit sty -> add_type bv sty)
|
||||||
|
fl
|
||||||
|
| Ptyp_poly(_, t) -> add_type bv t
|
||||||
|
| Ptyp_package pt -> add_package_type bv pt
|
||||||
|
| Ptyp_extension e -> handle_extension e
|
||||||
|
|
||||||
|
and add_package_type bv (lid, l) =
|
||||||
|
add bv lid;
|
||||||
|
List.iter (add_type bv) (List.map (fun (_, e) -> e) l)
|
||||||
|
|
||||||
|
let add_opt add_fn bv = function
|
||||||
|
None -> ()
|
||||||
|
| Some x -> add_fn bv x
|
||||||
|
|
||||||
|
let add_constructor_arguments bv = function
|
||||||
|
| Pcstr_tuple l -> List.iter (add_type bv) l
|
||||||
|
| Pcstr_record l -> List.iter (fun l -> add_type bv l.pld_type) l
|
||||||
|
|
||||||
|
let add_constructor_decl bv pcd =
|
||||||
|
add_constructor_arguments bv pcd.pcd_args;
|
||||||
|
Misc.may (add_type bv) pcd.pcd_res
|
||||||
|
|
||||||
|
let add_type_declaration bv td =
|
||||||
|
List.iter
|
||||||
|
(fun (ty1, ty2, _) -> add_type bv ty1; add_type bv ty2)
|
||||||
|
td.ptype_cstrs;
|
||||||
|
add_opt add_type bv td.ptype_manifest;
|
||||||
|
let add_tkind = function
|
||||||
|
Ptype_abstract -> ()
|
||||||
|
| Ptype_variant cstrs ->
|
||||||
|
List.iter (add_constructor_decl bv) cstrs
|
||||||
|
| Ptype_record lbls ->
|
||||||
|
List.iter (fun pld -> add_type bv pld.pld_type) lbls
|
||||||
|
| Ptype_open -> () in
|
||||||
|
add_tkind td.ptype_kind
|
||||||
|
|
||||||
|
let add_extension_constructor bv ext =
|
||||||
|
match ext.pext_kind with
|
||||||
|
Pext_decl(args, rty) ->
|
||||||
|
add_constructor_arguments bv args;
|
||||||
|
Misc.may (add_type bv) rty
|
||||||
|
| Pext_rebind lid -> add bv lid
|
||||||
|
|
||||||
|
let add_type_extension bv te =
|
||||||
|
add bv te.ptyext_path;
|
||||||
|
List.iter (add_extension_constructor bv) te.ptyext_constructors
|
||||||
|
|
||||||
|
let rec add_class_type bv cty =
|
||||||
|
match cty.pcty_desc with
|
||||||
|
Pcty_constr(l, tyl) ->
|
||||||
|
add bv l; List.iter (add_type bv) tyl
|
||||||
|
| Pcty_signature { pcsig_self = ty; pcsig_fields = fieldl } ->
|
||||||
|
add_type bv ty;
|
||||||
|
List.iter (add_class_type_field bv) fieldl
|
||||||
|
| Pcty_arrow(_, ty1, cty2) ->
|
||||||
|
add_type bv ty1; add_class_type bv cty2
|
||||||
|
| Pcty_extension e -> handle_extension e
|
||||||
|
| Pcty_open (_ovf, m, e) ->
|
||||||
|
let bv = open_module bv m.txt in add_class_type bv e
|
||||||
|
|
||||||
|
and add_class_type_field bv pctf =
|
||||||
|
match pctf.pctf_desc with
|
||||||
|
Pctf_inherit cty -> add_class_type bv cty
|
||||||
|
| Pctf_val(_, _, _, ty) -> add_type bv ty
|
||||||
|
| Pctf_method(_, _, _, ty) -> add_type bv ty
|
||||||
|
| Pctf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
|
||||||
|
| Pctf_attribute _ -> ()
|
||||||
|
| Pctf_extension e -> handle_extension e
|
||||||
|
|
||||||
|
let add_class_description bv infos =
|
||||||
|
add_class_type bv infos.pci_expr
|
||||||
|
|
||||||
|
let add_class_type_declaration = add_class_description
|
||||||
|
|
||||||
|
let pattern_bv = ref StringMap.empty
|
||||||
|
|
||||||
|
let rec add_pattern bv pat =
|
||||||
|
match pat.ppat_desc with
|
||||||
|
Ppat_any -> ()
|
||||||
|
| Ppat_var _ -> ()
|
||||||
|
| Ppat_alias(p, _) -> add_pattern bv p
|
||||||
|
| Ppat_interval _
|
||||||
|
| Ppat_constant _ -> ()
|
||||||
|
| Ppat_tuple pl -> List.iter (add_pattern bv) pl
|
||||||
|
| Ppat_construct(c, op) -> add bv c; add_opt add_pattern bv op
|
||||||
|
| Ppat_record(pl, _) ->
|
||||||
|
List.iter (fun (lbl, p) -> add bv lbl; add_pattern bv p) pl
|
||||||
|
| Ppat_array pl -> List.iter (add_pattern bv) pl
|
||||||
|
| Ppat_or(p1, p2) -> add_pattern bv p1; add_pattern bv p2
|
||||||
|
| Ppat_constraint(p, ty) -> add_pattern bv p; add_type bv ty
|
||||||
|
| Ppat_variant(_, op) -> add_opt add_pattern bv op
|
||||||
|
| Ppat_type li -> add bv li
|
||||||
|
| Ppat_lazy p -> add_pattern bv p
|
||||||
|
| Ppat_unpack id -> pattern_bv := StringMap.add id.txt bound !pattern_bv
|
||||||
|
| Ppat_open ( m, p) -> let bv = open_module bv m.txt in add_pattern bv p
|
||||||
|
| Ppat_exception p -> add_pattern bv p
|
||||||
|
| Ppat_extension e -> handle_extension e
|
||||||
|
|
||||||
|
let add_pattern bv pat =
|
||||||
|
pattern_bv := bv;
|
||||||
|
add_pattern bv pat;
|
||||||
|
!pattern_bv
|
||||||
|
|
||||||
|
let rec add_expr bv exp =
|
||||||
|
match exp.pexp_desc with
|
||||||
|
Pexp_ident l -> add bv l
|
||||||
|
| Pexp_constant _ -> ()
|
||||||
|
| Pexp_let(rf, pel, e) ->
|
||||||
|
let bv = add_bindings rf bv pel in add_expr bv e
|
||||||
|
| Pexp_fun (_, opte, p, e) ->
|
||||||
|
add_opt add_expr bv opte; add_expr (add_pattern bv p) e
|
||||||
|
| Pexp_function pel ->
|
||||||
|
add_cases bv pel
|
||||||
|
| Pexp_apply(e, el) ->
|
||||||
|
add_expr bv e; List.iter (fun (_,e) -> add_expr bv e) el
|
||||||
|
| Pexp_match(e, pel) -> add_expr bv e; add_cases bv pel
|
||||||
|
| Pexp_try(e, pel) -> add_expr bv e; add_cases bv pel
|
||||||
|
| Pexp_tuple el -> List.iter (add_expr bv) el
|
||||||
|
| Pexp_construct(c, opte) -> add bv c; add_opt add_expr bv opte
|
||||||
|
| Pexp_variant(_, opte) -> add_opt add_expr bv opte
|
||||||
|
| Pexp_record(lblel, opte) ->
|
||||||
|
List.iter (fun (lbl, e) -> add bv lbl; add_expr bv e) lblel;
|
||||||
|
add_opt add_expr bv opte
|
||||||
|
| Pexp_field(e, fld) -> add_expr bv e; add bv fld
|
||||||
|
| Pexp_setfield(e1, fld, e2) -> add_expr bv e1; add bv fld; add_expr bv e2
|
||||||
|
| Pexp_array el -> List.iter (add_expr bv) el
|
||||||
|
| Pexp_ifthenelse(e1, e2, opte3) ->
|
||||||
|
add_expr bv e1; add_expr bv e2; add_opt add_expr bv opte3
|
||||||
|
| Pexp_sequence(e1, e2) -> add_expr bv e1; add_expr bv e2
|
||||||
|
| Pexp_while(e1, e2) -> add_expr bv e1; add_expr bv e2
|
||||||
|
| Pexp_for( _, e1, e2, _, e3) ->
|
||||||
|
add_expr bv e1; add_expr bv e2; add_expr bv e3
|
||||||
|
| Pexp_coerce(e1, oty2, ty3) ->
|
||||||
|
add_expr bv e1;
|
||||||
|
add_opt add_type bv oty2;
|
||||||
|
add_type bv ty3
|
||||||
|
| Pexp_constraint(e1, ty2) ->
|
||||||
|
add_expr bv e1;
|
||||||
|
add_type bv ty2
|
||||||
|
| Pexp_send(e, _m) -> add_expr bv e
|
||||||
|
| Pexp_new li -> add bv li
|
||||||
|
| Pexp_setinstvar(_v, e) -> add_expr bv e
|
||||||
|
| Pexp_override sel -> List.iter (fun (_s, e) -> add_expr bv e) sel
|
||||||
|
| Pexp_letmodule(id, m, e) ->
|
||||||
|
let b = add_module_binding bv m in
|
||||||
|
add_expr (StringMap.add id.txt b bv) e
|
||||||
|
| Pexp_letexception(_, e) -> add_expr bv e
|
||||||
|
| Pexp_assert (e) -> add_expr bv e
|
||||||
|
| Pexp_lazy (e) -> add_expr bv e
|
||||||
|
| Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
|
||||||
|
| Pexp_object { pcstr_self = pat; pcstr_fields = fieldl } ->
|
||||||
|
let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
|
||||||
|
| Pexp_newtype (_, e) -> add_expr bv e
|
||||||
|
| Pexp_pack m -> add_module_expr bv m
|
||||||
|
| Pexp_open (_ovf, m, e) ->
|
||||||
|
let bv = open_module bv m.txt in add_expr bv e
|
||||||
|
| Pexp_extension (({ txt = ("ocaml.extension_constructor"|
|
||||||
|
"extension_constructor"); _ },
|
||||||
|
PStr [item]) as e) ->
|
||||||
|
begin match item.pstr_desc with
|
||||||
|
| Pstr_eval ({ pexp_desc = Pexp_construct (c, None) }, _) -> add bv c
|
||||||
|
| _ -> handle_extension e
|
||||||
|
end
|
||||||
|
| Pexp_extension e -> handle_extension e
|
||||||
|
| Pexp_unreachable -> ()
|
||||||
|
|
||||||
|
and add_cases bv cases =
|
||||||
|
List.iter (add_case bv) cases
|
||||||
|
|
||||||
|
and add_case bv {pc_lhs; pc_guard; pc_rhs} =
|
||||||
|
let bv = add_pattern bv pc_lhs in
|
||||||
|
add_opt add_expr bv pc_guard;
|
||||||
|
add_expr bv pc_rhs
|
||||||
|
|
||||||
|
and add_bindings recf bv pel =
|
||||||
|
let bv' = List.fold_left (fun bv x -> add_pattern bv x.pvb_pat) bv pel in
|
||||||
|
let bv = if recf = Recursive then bv' else bv in
|
||||||
|
List.iter (fun x -> add_expr bv x.pvb_expr) pel;
|
||||||
|
bv'
|
||||||
|
|
||||||
|
and add_modtype bv mty =
|
||||||
|
match mty.pmty_desc with
|
||||||
|
Pmty_ident l -> add bv l
|
||||||
|
| Pmty_alias l -> add_module_path bv l
|
||||||
|
| Pmty_signature s -> add_signature bv s
|
||||||
|
| Pmty_functor(id, mty1, mty2) ->
|
||||||
|
Misc.may (add_modtype bv) mty1;
|
||||||
|
add_modtype (StringMap.add id.txt bound bv) mty2
|
||||||
|
| Pmty_with(mty, cstrl) ->
|
||||||
|
add_modtype bv mty;
|
||||||
|
List.iter
|
||||||
|
(function
|
||||||
|
| Pwith_type (_, td) -> add_type_declaration bv td
|
||||||
|
| Pwith_module (_, lid) -> add_module_path bv lid
|
||||||
|
| Pwith_typesubst (_, td) -> add_type_declaration bv td
|
||||||
|
| Pwith_modsubst (_, lid) -> add_module_path bv lid
|
||||||
|
)
|
||||||
|
cstrl
|
||||||
|
| Pmty_typeof m -> add_module_expr bv m
|
||||||
|
| Pmty_extension e -> handle_extension e
|
||||||
|
|
||||||
|
and add_module_alias bv l =
|
||||||
|
(* If we are in delayed dependencies mode, we delay the dependencies
|
||||||
|
induced by "Lident s" *)
|
||||||
|
(if !Clflags.transparent_modules then add_parent else add_module_path) bv l;
|
||||||
|
try
|
||||||
|
lookup_map l.txt bv
|
||||||
|
with Not_found ->
|
||||||
|
match l.txt with
|
||||||
|
Lident s -> make_leaf s
|
||||||
|
| _ -> add_module_path bv l; bound (* cannot delay *)
|
||||||
|
|
||||||
|
and add_modtype_binding bv mty =
|
||||||
|
match mty.pmty_desc with
|
||||||
|
Pmty_alias l ->
|
||||||
|
add_module_alias bv l
|
||||||
|
| Pmty_signature s ->
|
||||||
|
make_node (add_signature_binding bv s)
|
||||||
|
| Pmty_typeof modl ->
|
||||||
|
add_module_binding bv modl
|
||||||
|
| _ ->
|
||||||
|
add_modtype bv mty; bound
|
||||||
|
|
||||||
|
and add_signature bv sg =
|
||||||
|
ignore (add_signature_binding bv sg)
|
||||||
|
|
||||||
|
and add_signature_binding bv sg =
|
||||||
|
snd (List.fold_left add_sig_item (bv, StringMap.empty) sg)
|
||||||
|
|
||||||
|
and add_sig_item (bv, m) item =
|
||||||
|
match item.psig_desc with
|
||||||
|
Psig_value vd ->
|
||||||
|
add_type bv vd.pval_type; (bv, m)
|
||||||
|
| Psig_type (_, dcls) ->
|
||||||
|
List.iter (add_type_declaration bv) dcls; (bv, m)
|
||||||
|
| Psig_typext te ->
|
||||||
|
add_type_extension bv te; (bv, m)
|
||||||
|
| Psig_exception pext ->
|
||||||
|
add_extension_constructor bv pext; (bv, m)
|
||||||
|
| Psig_module pmd ->
|
||||||
|
let m' = add_modtype_binding bv pmd.pmd_type in
|
||||||
|
let add = StringMap.add pmd.pmd_name.txt m' in
|
||||||
|
(add bv, add m)
|
||||||
|
| Psig_recmodule decls ->
|
||||||
|
let add =
|
||||||
|
List.fold_right (fun pmd -> StringMap.add pmd.pmd_name.txt bound)
|
||||||
|
decls
|
||||||
|
in
|
||||||
|
let bv' = add bv and m' = add m in
|
||||||
|
List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls;
|
||||||
|
(bv', m')
|
||||||
|
| Psig_modtype x ->
|
||||||
|
begin match x.pmtd_type with
|
||||||
|
None -> ()
|
||||||
|
| Some mty -> add_modtype bv mty
|
||||||
|
end;
|
||||||
|
(bv, m)
|
||||||
|
| Psig_open od ->
|
||||||
|
(open_module bv od.popen_lid.txt, m)
|
||||||
|
| Psig_include incl ->
|
||||||
|
let Node (s, m') = add_modtype_binding bv incl.pincl_mod in
|
||||||
|
add_names s;
|
||||||
|
let add = StringMap.fold StringMap.add m' in
|
||||||
|
(add bv, add m)
|
||||||
|
| Psig_class cdl ->
|
||||||
|
List.iter (add_class_description bv) cdl; (bv, m)
|
||||||
|
| Psig_class_type cdtl ->
|
||||||
|
List.iter (add_class_type_declaration bv) cdtl; (bv, m)
|
||||||
|
| Psig_attribute _ -> (bv, m)
|
||||||
|
| Psig_extension (e, _) ->
|
||||||
|
handle_extension e;
|
||||||
|
(bv, m)
|
||||||
|
|
||||||
|
and add_module_binding bv modl =
|
||||||
|
match modl.pmod_desc with
|
||||||
|
Pmod_ident l -> add_module_alias bv l
|
||||||
|
| Pmod_structure s ->
|
||||||
|
make_node (snd @@ add_structure_binding bv s)
|
||||||
|
| _ -> add_module_expr bv modl; bound
|
||||||
|
|
||||||
|
and add_module_expr bv modl =
|
||||||
|
match modl.pmod_desc with
|
||||||
|
Pmod_ident l -> add_module_path bv l
|
||||||
|
| Pmod_structure s -> ignore (add_structure bv s)
|
||||||
|
| Pmod_functor(id, mty, modl) ->
|
||||||
|
Misc.may (add_modtype bv) mty;
|
||||||
|
add_module_expr (StringMap.add id.txt bound bv) modl
|
||||||
|
| Pmod_apply(mod1, mod2) ->
|
||||||
|
add_module_expr bv mod1; add_module_expr bv mod2
|
||||||
|
| Pmod_constraint(modl, mty) ->
|
||||||
|
add_module_expr bv modl; add_modtype bv mty
|
||||||
|
| Pmod_unpack(e) ->
|
||||||
|
add_expr bv e
|
||||||
|
| Pmod_extension e ->
|
||||||
|
handle_extension e
|
||||||
|
|
||||||
|
and add_structure bv item_list =
|
||||||
|
let (bv, m) = add_structure_binding bv item_list in
|
||||||
|
add_names (collect_free (make_node m));
|
||||||
|
bv
|
||||||
|
|
||||||
|
and add_structure_binding bv item_list =
|
||||||
|
List.fold_left add_struct_item (bv, StringMap.empty) item_list
|
||||||
|
|
||||||
|
and add_struct_item (bv, m) item : _ StringMap.t * _ StringMap.t =
|
||||||
|
match item.pstr_desc with
|
||||||
|
Pstr_eval (e, _attrs) ->
|
||||||
|
add_expr bv e; (bv, m)
|
||||||
|
| Pstr_value(rf, pel) ->
|
||||||
|
let bv = add_bindings rf bv pel in (bv, m)
|
||||||
|
| Pstr_primitive vd ->
|
||||||
|
add_type bv vd.pval_type; (bv, m)
|
||||||
|
| Pstr_type (_, dcls) ->
|
||||||
|
List.iter (add_type_declaration bv) dcls; (bv, m)
|
||||||
|
| Pstr_typext te ->
|
||||||
|
add_type_extension bv te;
|
||||||
|
(bv, m)
|
||||||
|
| Pstr_exception pext ->
|
||||||
|
add_extension_constructor bv pext; (bv, m)
|
||||||
|
| Pstr_module x ->
|
||||||
|
let b = add_module_binding bv x.pmb_expr in
|
||||||
|
let add = StringMap.add x.pmb_name.txt b in
|
||||||
|
(add bv, add m)
|
||||||
|
| Pstr_recmodule bindings ->
|
||||||
|
let add =
|
||||||
|
List.fold_right (fun x -> StringMap.add x.pmb_name.txt bound) bindings
|
||||||
|
in
|
||||||
|
let bv' = add bv and m = add m in
|
||||||
|
List.iter
|
||||||
|
(fun x -> add_module_expr bv' x.pmb_expr)
|
||||||
|
bindings;
|
||||||
|
(bv', m)
|
||||||
|
| Pstr_modtype x ->
|
||||||
|
begin match x.pmtd_type with
|
||||||
|
None -> ()
|
||||||
|
| Some mty -> add_modtype bv mty
|
||||||
|
end;
|
||||||
|
(bv, m)
|
||||||
|
| Pstr_open od ->
|
||||||
|
(open_module bv od.popen_lid.txt, m)
|
||||||
|
| Pstr_class cdl ->
|
||||||
|
List.iter (add_class_declaration bv) cdl; (bv, m)
|
||||||
|
| Pstr_class_type cdtl ->
|
||||||
|
List.iter (add_class_type_declaration bv) cdtl; (bv, m)
|
||||||
|
| Pstr_include incl ->
|
||||||
|
let Node (s, m') as n = add_module_binding bv incl.pincl_mod in
|
||||||
|
if !Clflags.transparent_modules then
|
||||||
|
add_names s
|
||||||
|
else
|
||||||
|
(* If we are not in the delayed dependency mode, we need to
|
||||||
|
collect all delayed dependencies imported by the include statement *)
|
||||||
|
add_names (collect_free n);
|
||||||
|
let add = StringMap.fold StringMap.add m' in
|
||||||
|
(add bv, add m)
|
||||||
|
| Pstr_attribute _ -> (bv, m)
|
||||||
|
| Pstr_extension (e, _) ->
|
||||||
|
handle_extension e;
|
||||||
|
(bv, m)
|
||||||
|
|
||||||
|
and add_use_file bv top_phrs =
|
||||||
|
ignore (List.fold_left add_top_phrase bv top_phrs)
|
||||||
|
|
||||||
|
and add_implementation bv l =
|
||||||
|
ignore (add_structure_binding bv l)
|
||||||
|
|
||||||
|
and add_implementation_binding bv l =
|
||||||
|
snd (add_structure_binding bv l)
|
||||||
|
|
||||||
|
and add_top_phrase bv = function
|
||||||
|
| Ptop_def str -> add_structure bv str
|
||||||
|
| Ptop_dir (_, _) -> bv
|
||||||
|
|
||||||
|
and add_class_expr bv ce =
|
||||||
|
match ce.pcl_desc with
|
||||||
|
Pcl_constr(l, tyl) ->
|
||||||
|
add bv l; List.iter (add_type bv) tyl
|
||||||
|
| Pcl_structure { pcstr_self = pat; pcstr_fields = fieldl } ->
|
||||||
|
let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
|
||||||
|
| Pcl_fun(_, opte, pat, ce) ->
|
||||||
|
add_opt add_expr bv opte;
|
||||||
|
let bv = add_pattern bv pat in add_class_expr bv ce
|
||||||
|
| Pcl_apply(ce, exprl) ->
|
||||||
|
add_class_expr bv ce; List.iter (fun (_,e) -> add_expr bv e) exprl
|
||||||
|
| Pcl_let(rf, pel, ce) ->
|
||||||
|
let bv = add_bindings rf bv pel in add_class_expr bv ce
|
||||||
|
| Pcl_constraint(ce, ct) ->
|
||||||
|
add_class_expr bv ce; add_class_type bv ct
|
||||||
|
| Pcl_extension e -> handle_extension e
|
||||||
|
| Pcl_open (_ovf, m, e) ->
|
||||||
|
let bv = open_module bv m.txt in add_class_expr bv e
|
||||||
|
|
||||||
|
and add_class_field bv pcf =
|
||||||
|
match pcf.pcf_desc with
|
||||||
|
Pcf_inherit(_, ce, _) -> add_class_expr bv ce
|
||||||
|
| Pcf_val(_, _, Cfk_concrete (_, e))
|
||||||
|
| Pcf_method(_, _, Cfk_concrete (_, e)) -> add_expr bv e
|
||||||
|
| Pcf_val(_, _, Cfk_virtual ty)
|
||||||
|
| Pcf_method(_, _, Cfk_virtual ty) -> add_type bv ty
|
||||||
|
| Pcf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
|
||||||
|
| Pcf_initializer e -> add_expr bv e
|
||||||
|
| Pcf_attribute _ -> ()
|
||||||
|
| Pcf_extension e -> handle_extension e
|
||||||
|
|
||||||
|
and add_class_declaration bv decl =
|
||||||
|
add_class_expr bv decl.pci_expr
|
||||||
4
miniml/interp/depend.sh
Executable file
4
miniml/interp/depend.sh
Executable file
@ -0,0 +1,4 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
r=$(dirname $0)
|
||||||
|
root=$r/../..
|
||||||
|
$root/ocaml-src/byterun/ocamlrun $r/makedepend.byte "$@"
|
||||||
@ -48,9 +48,11 @@ let mkprintf is_format print_fun ff fmt cont =
|
|||||||
Obj.magic (loop 0)
|
Obj.magic (loop 0)
|
||||||
|
|
||||||
let getff ff = ff.out_string
|
let getff ff = ff.out_string
|
||||||
let printf fmt = mkprintf true getff { out_string = print_string } fmt (fun () -> ())
|
let std_formatter = { out_string = print_string }
|
||||||
|
let err_formatter = { out_string = print_err }
|
||||||
let fprintf ff fmt = mkprintf true getff ff fmt (fun () -> ())
|
let fprintf ff fmt = mkprintf true getff ff fmt (fun () -> ())
|
||||||
let eprintf fmt = mkprintf true getff { out_string = print_err } fmt (fun () -> ())
|
let printf fmt = fprintf std_formatter fmt
|
||||||
|
let eprintf fmt = fprintf err_formatter fmt
|
||||||
let kbprintf k b fmt = mkprintf true getff { out_string = Buffer.add_string b } fmt (fun () -> k b)
|
let kbprintf k b fmt = mkprintf true getff { out_string = Buffer.add_string b } fmt (fun () -> k b)
|
||||||
let bprintf b fmt = kbprintf (fun _ -> ()) b fmt
|
let bprintf b fmt = kbprintf (fun _ -> ()) b fmt
|
||||||
let kprintf k fmt = kbprintf (fun b -> k (Buffer.contents b)) (Buffer.create 16) fmt
|
let kprintf k fmt = kbprintf (fun b -> k (Buffer.contents b)) (Buffer.create 16) fmt
|
||||||
|
|||||||
415
miniml/interp/makedepend.ml
Normal file
415
miniml/interp/makedepend.ml
Normal file
@ -0,0 +1,415 @@
|
|||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* OCaml *)
|
||||||
|
(* *)
|
||||||
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 1999 Institut National de Recherche en Informatique et *)
|
||||||
|
(* en Automatique. *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of *)
|
||||||
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||||
|
(* special exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
open Parsetree
|
||||||
|
|
||||||
|
module StringMap = Depend.StringMap
|
||||||
|
module StringSet = Depend.StringSet
|
||||||
|
|
||||||
|
let ppf = Format.err_formatter
|
||||||
|
(* Print the dependencies *)
|
||||||
|
|
||||||
|
type file_kind = ML | MLI;;
|
||||||
|
|
||||||
|
let first_include_dirs = ref ([] : string list)
|
||||||
|
let include_dirs = ref ([] : string list)
|
||||||
|
let load_path = ref ([] : (string * string array) list)
|
||||||
|
let ml_synonyms = ref [".ml"]
|
||||||
|
let mli_synonyms = ref [".mli"]
|
||||||
|
let shared = ref false
|
||||||
|
let native_only = ref false
|
||||||
|
let bytecode_only = ref false
|
||||||
|
let error_occurred = ref false
|
||||||
|
let raw_dependencies = ref false
|
||||||
|
let all_dependencies = ref false
|
||||||
|
let one_line = ref false
|
||||||
|
let files =
|
||||||
|
ref ([] : (string * file_kind * StringSet.t * string list) list)
|
||||||
|
|
||||||
|
let map_files = ref []
|
||||||
|
let module_map = ref StringMap.empty
|
||||||
|
let debug = ref false
|
||||||
|
|
||||||
|
(* Fix path to use '/' as directory separator instead of '\'.
|
||||||
|
Only under Windows. *)
|
||||||
|
|
||||||
|
let fix_slash s =
|
||||||
|
if Sys.os_type = "Unix" then s else begin
|
||||||
|
String.map (function '\\' -> '/' | c -> c) s
|
||||||
|
end
|
||||||
|
|
||||||
|
(* Since we reinitialize load_path after reading OCAMLCOMP,
|
||||||
|
we must use a cache instead of calling Sys.readdir too often. *)
|
||||||
|
let dirs = ref StringMap.empty
|
||||||
|
let readdir dir =
|
||||||
|
try
|
||||||
|
StringMap.find dir !dirs
|
||||||
|
with Not_found ->
|
||||||
|
let contents =
|
||||||
|
try
|
||||||
|
Sys.readdir dir
|
||||||
|
with Sys_error msg ->
|
||||||
|
Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg;
|
||||||
|
error_occurred := true;
|
||||||
|
[||]
|
||||||
|
in
|
||||||
|
dirs := StringMap.add dir contents !dirs;
|
||||||
|
contents
|
||||||
|
|
||||||
|
let add_to_list li s =
|
||||||
|
li := s :: !li
|
||||||
|
|
||||||
|
let add_to_load_path dir =
|
||||||
|
try
|
||||||
|
(* let dir = Misc.expand_directory Config.standard_library dir in *)
|
||||||
|
let contents = readdir dir in
|
||||||
|
add_to_list load_path (dir, contents)
|
||||||
|
with Sys_error msg ->
|
||||||
|
Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg;
|
||||||
|
error_occurred := true
|
||||||
|
|
||||||
|
let add_to_synonym_list synonyms suffix =
|
||||||
|
if (String.length suffix) > 1 && suffix.[0] = '.' then
|
||||||
|
add_to_list synonyms suffix
|
||||||
|
else begin
|
||||||
|
Format.fprintf Format.err_formatter "@[Bad suffix: '%s'@]@." suffix;
|
||||||
|
error_occurred := true
|
||||||
|
end
|
||||||
|
|
||||||
|
(* Find file 'name' (capitalized) in search path *)
|
||||||
|
let find_file name =
|
||||||
|
let uname = String.uncapitalize_ascii name in
|
||||||
|
let rec find_in_array a pos =
|
||||||
|
if pos >= Array.length a then None else begin
|
||||||
|
let s = a.(pos) in
|
||||||
|
if s = name || s = uname then Some s else find_in_array a (pos + 1)
|
||||||
|
end in
|
||||||
|
let rec find_in_path = function
|
||||||
|
[] -> raise Not_found
|
||||||
|
| (dir, contents) :: rem ->
|
||||||
|
match find_in_array contents 0 with
|
||||||
|
Some truename ->
|
||||||
|
if dir = "." then truename else Filename.concat dir truename
|
||||||
|
| None -> find_in_path rem in
|
||||||
|
find_in_path !load_path
|
||||||
|
|
||||||
|
let rec find_file_in_list = function
|
||||||
|
[] -> raise Not_found
|
||||||
|
| x :: rem -> try find_file x with Not_found -> find_file_in_list rem
|
||||||
|
|
||||||
|
|
||||||
|
let find_dependency target_kind modname (byt_deps, opt_deps) =
|
||||||
|
try
|
||||||
|
let candidates = List.map ((^) modname) !mli_synonyms in
|
||||||
|
let filename = find_file_in_list candidates in
|
||||||
|
let basename = Filename.chop_extension filename in
|
||||||
|
let cmi_file = basename ^ ".cmi" in
|
||||||
|
let cmx_file = basename ^ ".cmx" in
|
||||||
|
let ml_exists =
|
||||||
|
List.exists (fun ext -> Sys.file_exists (basename ^ ext)) !ml_synonyms in
|
||||||
|
let new_opt_dep =
|
||||||
|
if !all_dependencies then
|
||||||
|
match target_kind with
|
||||||
|
| MLI -> [ cmi_file ]
|
||||||
|
| ML ->
|
||||||
|
cmi_file :: (if ml_exists then [ cmx_file ] else [])
|
||||||
|
else
|
||||||
|
(* this is a make-specific hack that makes .cmx to be a 'proxy'
|
||||||
|
target that would force the dependency on .cmi via transitivity *)
|
||||||
|
if ml_exists
|
||||||
|
then [ cmx_file ]
|
||||||
|
else [ cmi_file ]
|
||||||
|
in
|
||||||
|
( cmi_file :: byt_deps, new_opt_dep @ opt_deps)
|
||||||
|
with Not_found ->
|
||||||
|
try
|
||||||
|
(* "just .ml" case *)
|
||||||
|
let candidates = List.map ((^) modname) !ml_synonyms in
|
||||||
|
let filename = find_file_in_list candidates in
|
||||||
|
let basename = Filename.chop_extension filename in
|
||||||
|
let cmi_file = basename ^ ".cmi" in
|
||||||
|
let cmx_file = basename ^ ".cmx" in
|
||||||
|
let bytenames =
|
||||||
|
if !all_dependencies then
|
||||||
|
match target_kind with
|
||||||
|
| MLI -> [ cmi_file ]
|
||||||
|
| ML -> [ cmi_file ]
|
||||||
|
else
|
||||||
|
(* again, make-specific hack *)
|
||||||
|
[basename ^ (if !native_only then ".cmx" else ".cmo")] in
|
||||||
|
let optnames =
|
||||||
|
if !all_dependencies
|
||||||
|
then match target_kind with
|
||||||
|
| MLI -> [ cmi_file ]
|
||||||
|
| ML -> [ cmi_file; cmx_file ]
|
||||||
|
else [ cmx_file ]
|
||||||
|
in
|
||||||
|
(bytenames @ byt_deps, optnames @ opt_deps)
|
||||||
|
with Not_found ->
|
||||||
|
(byt_deps, opt_deps)
|
||||||
|
|
||||||
|
let depends_on = ":"
|
||||||
|
let escaped_eol = " \\\n "
|
||||||
|
|
||||||
|
let print_filename s =
|
||||||
|
let s = fix_slash s in
|
||||||
|
if not (String.contains s ' ') then begin
|
||||||
|
print_string s;
|
||||||
|
end else begin
|
||||||
|
let rec count n i =
|
||||||
|
if i >= String.length s then n
|
||||||
|
else if s.[i] = ' ' then count (n+1) (i+1)
|
||||||
|
else count n (i+1)
|
||||||
|
in
|
||||||
|
let spaces = count 0 0 in
|
||||||
|
let result = Bytes.create (String.length s + spaces) in
|
||||||
|
let rec loop i j =
|
||||||
|
if i >= String.length s then ()
|
||||||
|
else if s.[i] = ' ' then begin
|
||||||
|
Bytes.set result j '\\';
|
||||||
|
Bytes.set result (j+1) ' ';
|
||||||
|
loop (i+1) (j+2);
|
||||||
|
end else begin
|
||||||
|
Bytes.set result j s.[i];
|
||||||
|
loop (i+1) (j+1);
|
||||||
|
end
|
||||||
|
in
|
||||||
|
loop 0 0;
|
||||||
|
print_bytes result;
|
||||||
|
end
|
||||||
|
;;
|
||||||
|
|
||||||
|
let print_dependencies target_files deps =
|
||||||
|
let rec print_items pos = function
|
||||||
|
[] -> print_string "\n"
|
||||||
|
| dep :: rem ->
|
||||||
|
if !one_line || (pos + 1 + String.length dep <= 77) then begin
|
||||||
|
if pos <> 0 then print_string " "; print_filename dep;
|
||||||
|
print_items (pos + String.length dep + 1) rem
|
||||||
|
end else begin
|
||||||
|
print_string escaped_eol; print_filename dep;
|
||||||
|
print_items (String.length dep + 4) rem
|
||||||
|
end in
|
||||||
|
print_items 0 (target_files @ [depends_on] @ deps)
|
||||||
|
|
||||||
|
let print_raw_dependencies source_file deps =
|
||||||
|
print_filename source_file; print_string depends_on;
|
||||||
|
StringSet.iter
|
||||||
|
(fun dep ->
|
||||||
|
(* filter out "*predef*" *)
|
||||||
|
if (String.length dep > 0)
|
||||||
|
&& (match dep.[0] with
|
||||||
|
| 'A'..'Z' | '\128'..'\255' -> true
|
||||||
|
| _ -> false) then
|
||||||
|
begin
|
||||||
|
print_char ' ';
|
||||||
|
print_string dep
|
||||||
|
end)
|
||||||
|
deps;
|
||||||
|
print_char '\n'
|
||||||
|
|
||||||
|
|
||||||
|
(* Process one file *)
|
||||||
|
|
||||||
|
let report_err exn = error_occurred := true
|
||||||
|
|
||||||
|
let tool_name = "ocamldep"
|
||||||
|
|
||||||
|
let rec lexical_approximation lexbuf =
|
||||||
|
(* Approximation when a file can't be parsed.
|
||||||
|
Heuristic:
|
||||||
|
- first component of any path starting with an uppercase character is a
|
||||||
|
dependency.
|
||||||
|
- always skip the token after a dot, unless dot is preceded by a
|
||||||
|
lower-case identifier
|
||||||
|
- always skip the token after a backquote
|
||||||
|
*)
|
||||||
|
try
|
||||||
|
let rec process after_lident lexbuf =
|
||||||
|
match Lexer.token lexbuf with
|
||||||
|
| Parser.UIDENT name ->
|
||||||
|
Depend.free_structure_names :=
|
||||||
|
StringSet.add name !Depend.free_structure_names;
|
||||||
|
process false lexbuf
|
||||||
|
| Parser.LIDENT _ -> process true lexbuf
|
||||||
|
| Parser.DOT when after_lident -> process false lexbuf
|
||||||
|
| Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf
|
||||||
|
| Parser.EOF -> ()
|
||||||
|
| _ -> process false lexbuf
|
||||||
|
and skip_one lexbuf =
|
||||||
|
match Lexer.token lexbuf with
|
||||||
|
| Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf
|
||||||
|
| Parser.EOF -> ()
|
||||||
|
| _ -> process false lexbuf
|
||||||
|
|
||||||
|
in
|
||||||
|
process false lexbuf
|
||||||
|
with Lexer.Error _ -> lexical_approximation lexbuf
|
||||||
|
|
||||||
|
let read_and_approximate inputfile =
|
||||||
|
error_occurred := false;
|
||||||
|
Depend.free_structure_names := StringSet.empty;
|
||||||
|
let ic = open_in_bin inputfile in
|
||||||
|
try
|
||||||
|
seek_in ic 0;
|
||||||
|
Location.input_name := inputfile;
|
||||||
|
let lexbuf = Lexing.from_channel ic in
|
||||||
|
Location.init lexbuf inputfile;
|
||||||
|
lexical_approximation lexbuf;
|
||||||
|
close_in ic;
|
||||||
|
!Depend.free_structure_names
|
||||||
|
with exn ->
|
||||||
|
close_in ic;
|
||||||
|
report_err exn;
|
||||||
|
!Depend.free_structure_names
|
||||||
|
|
||||||
|
let read_parse_and_extract parse_function extract_function source_file =
|
||||||
|
Depend.pp_deps := [];
|
||||||
|
Depend.free_structure_names := Depend.StringSet.empty;
|
||||||
|
try
|
||||||
|
let ic = open_in source_file in
|
||||||
|
let lexbuf = Lexing.from_channel ic in
|
||||||
|
Location.init lexbuf source_file;
|
||||||
|
let ast = parse_function lexbuf in
|
||||||
|
let bound_vars = !module_map in
|
||||||
|
extract_function bound_vars ast;
|
||||||
|
!Depend.free_structure_names
|
||||||
|
with x -> begin
|
||||||
|
read_and_approximate source_file
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
let print_ml_dependencies source_file extracted_deps pp_deps =
|
||||||
|
let basename = Filename.chop_extension source_file in
|
||||||
|
let byte_targets = [ basename ^ ".cmo" ] in
|
||||||
|
let native_targets =
|
||||||
|
if !all_dependencies
|
||||||
|
then [ basename ^ ".cmx"; basename ^ ".o" ]
|
||||||
|
else [ basename ^ ".cmx" ] in
|
||||||
|
let shared_targets = [ basename ^ ".cmxs" ] in
|
||||||
|
let init_deps = if !all_dependencies then [source_file] else [] in
|
||||||
|
let cmi_name = basename ^ ".cmi" in
|
||||||
|
let init_deps, extra_targets =
|
||||||
|
if List.exists (fun ext -> Sys.file_exists (basename ^ ext))
|
||||||
|
!mli_synonyms
|
||||||
|
then (cmi_name :: init_deps, cmi_name :: init_deps), []
|
||||||
|
else (init_deps, init_deps),
|
||||||
|
(if !all_dependencies then [cmi_name] else [])
|
||||||
|
in
|
||||||
|
let (byt_deps, native_deps) =
|
||||||
|
StringSet.fold (find_dependency ML)
|
||||||
|
extracted_deps init_deps in
|
||||||
|
if not !native_only then
|
||||||
|
print_dependencies (byte_targets @ extra_targets) (byt_deps @ pp_deps);
|
||||||
|
if not !bytecode_only then
|
||||||
|
begin
|
||||||
|
print_dependencies (native_targets @ extra_targets)
|
||||||
|
(native_deps @ pp_deps);
|
||||||
|
if !shared then
|
||||||
|
print_dependencies (shared_targets @ extra_targets)
|
||||||
|
(native_deps @ pp_deps)
|
||||||
|
end
|
||||||
|
|
||||||
|
let print_mli_dependencies source_file extracted_deps pp_deps =
|
||||||
|
let basename = Filename.chop_extension source_file in
|
||||||
|
let (byt_deps, _opt_deps) =
|
||||||
|
StringSet.fold (find_dependency MLI)
|
||||||
|
extracted_deps ([], []) in
|
||||||
|
print_dependencies [basename ^ ".cmi"] (byt_deps @ pp_deps)
|
||||||
|
|
||||||
|
let print_file_dependencies (source_file, kind, extracted_deps, pp_deps) =
|
||||||
|
if !raw_dependencies then begin
|
||||||
|
print_raw_dependencies source_file extracted_deps
|
||||||
|
end else
|
||||||
|
match kind with
|
||||||
|
| ML -> print_ml_dependencies source_file extracted_deps pp_deps
|
||||||
|
| MLI -> print_mli_dependencies source_file extracted_deps pp_deps
|
||||||
|
|
||||||
|
|
||||||
|
let ml_file_dependencies source_file =
|
||||||
|
let parse_use_file_as_impl lexbuf =
|
||||||
|
let f x =
|
||||||
|
match x with
|
||||||
|
| Ptop_def s -> s
|
||||||
|
| Ptop_dir _ -> []
|
||||||
|
in
|
||||||
|
List.flatten (List.map f (Parse.use_file lexbuf))
|
||||||
|
in
|
||||||
|
let extracted_deps =
|
||||||
|
read_parse_and_extract parse_use_file_as_impl Depend.add_implementation source_file
|
||||||
|
in
|
||||||
|
files := (source_file, ML, extracted_deps, []) :: !files
|
||||||
|
|
||||||
|
let mli_file_dependencies source_file =
|
||||||
|
let extracted_deps =
|
||||||
|
read_parse_and_extract Parse.interface Depend.add_signature source_file
|
||||||
|
in
|
||||||
|
files := (source_file, MLI, extracted_deps, []) :: !files
|
||||||
|
|
||||||
|
let process_file_as process_fun def source_file =
|
||||||
|
load_path := [];
|
||||||
|
List.iter add_to_load_path (
|
||||||
|
(!include_dirs @
|
||||||
|
!first_include_dirs
|
||||||
|
));
|
||||||
|
Location.input_name := source_file;
|
||||||
|
try
|
||||||
|
if Sys.file_exists source_file then process_fun source_file else def
|
||||||
|
with x -> report_err x; def
|
||||||
|
|
||||||
|
let process_file source_file ~ml_file ~mli_file ~def =
|
||||||
|
if List.exists (Filename.check_suffix source_file) !ml_synonyms then
|
||||||
|
process_file_as ml_file def source_file
|
||||||
|
else if List.exists (Filename.check_suffix source_file) !mli_synonyms then
|
||||||
|
process_file_as mli_file def source_file
|
||||||
|
else def
|
||||||
|
|
||||||
|
let file_dependencies source_file =
|
||||||
|
process_file source_file ~def:()
|
||||||
|
~ml_file:ml_file_dependencies
|
||||||
|
~mli_file:mli_file_dependencies
|
||||||
|
|
||||||
|
let file_dependencies_as kind =
|
||||||
|
match kind with
|
||||||
|
| ML -> process_file_as ml_file_dependencies ()
|
||||||
|
| MLI -> process_file_as mli_file_dependencies ()
|
||||||
|
|
||||||
|
(* Entry point *)
|
||||||
|
|
||||||
|
let main () =
|
||||||
|
add_to_list first_include_dirs Filename.current_dir_name;
|
||||||
|
let specs = [
|
||||||
|
"-I", Arg.String (add_to_list include_dirs),
|
||||||
|
"<dir> Add <dir> to the list of include directories";
|
||||||
|
"-impl", Arg.String (file_dependencies_as ML),
|
||||||
|
"<f> Process <f> as a .ml file";
|
||||||
|
"-intf", Arg.String (file_dependencies_as MLI),
|
||||||
|
"<f> Process <f> as a .mli file";
|
||||||
|
"-native", Arg.Set native_only,
|
||||||
|
" Generate dependencies for native-code only (no .cmo files)";
|
||||||
|
"-bytecode", Arg.Set bytecode_only,
|
||||||
|
" Generate dependencies for bytecode-code only (no .cmx files)";
|
||||||
|
(* "-pp", Arg.String(fun s -> Clflags.preprocessor := Some s),
|
||||||
|
"<cmd> Pipe sources through preprocessor <cmd>"; *)
|
||||||
|
] in
|
||||||
|
let usage =
|
||||||
|
Printf.sprintf "Usage: %s [options] <source files>\nOptions are:"
|
||||||
|
(Filename.basename Sys.argv.(0))
|
||||||
|
in
|
||||||
|
Arg.parse specs file_dependencies usage;
|
||||||
|
List.iter print_file_dependencies (List.sort compare !files);
|
||||||
|
exit (if !error_occurred then 2 else 0)
|
||||||
|
|
||||||
|
let () = main ()
|
||||||
@ -23,3 +23,5 @@ let create_hashtable size init =
|
|||||||
let tbl = Hashtbl.create size in
|
let tbl = Hashtbl.create size in
|
||||||
List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
|
List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
|
||||||
tbl
|
tbl
|
||||||
|
|
||||||
|
let may f = function Some x -> f x | None -> ()
|
||||||
|
|||||||
@ -190,9 +190,12 @@ external pos_in : in_channel -> int = "caml_ml_pos_in"
|
|||||||
|
|
||||||
let output_string oc s =
|
let output_string oc s =
|
||||||
unsafe_output_string oc s 0 (string_length s)
|
unsafe_output_string oc s 0 (string_length s)
|
||||||
|
let output_bytes oc s =
|
||||||
|
unsafe_output oc s 0 (bytes_length s)
|
||||||
|
|
||||||
let print_char c = output_char stdout c
|
let print_char c = output_char stdout c
|
||||||
let print_string s = output_string stdout s; flush stdout
|
let print_string s = output_string stdout s; flush stdout
|
||||||
|
let print_bytes s = output_bytes stdout s; flush stdout
|
||||||
let print_newline () = print_string "\n"
|
let print_newline () = print_string "\n"
|
||||||
let print_endline s = print_string s; print_newline ()
|
let print_endline s = print_string s; print_newline ()
|
||||||
let print_err s = output_string stderr s; flush stderr
|
let print_err s = output_string stderr s; flush stderr
|
||||||
@ -254,6 +257,7 @@ module Sys = struct
|
|||||||
external getcwd: unit -> string = "caml_sys_getcwd"
|
external getcwd: unit -> string = "caml_sys_getcwd"
|
||||||
external rename : string -> string -> unit = "caml_sys_rename"
|
external rename : string -> string -> unit = "caml_sys_rename"
|
||||||
external remove: string -> unit = "caml_sys_remove"
|
external remove: string -> unit = "caml_sys_remove"
|
||||||
|
external readdir : string -> string array = "caml_sys_read_directory"
|
||||||
|
|
||||||
let os_type = ""
|
let os_type = ""
|
||||||
let ocaml_version = "camlboot"
|
let ocaml_version = "camlboot"
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user