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.ml > $(BOOT)/stdlib/stdlib.pp.ml
|
||||
cp $(OCAMLSRC)/asmrun/libasmrun.a $(BOOT)/stdlib/
|
||||
cp Makefile.stdlib $(BOOT)/stdlib/Makefile
|
||||
|
||||
COPY_TARGETS=\
|
||||
$(BOOT)/bytecomp \
|
||||
@ -108,6 +109,7 @@ COPY_TARGETS=\
|
||||
|
||||
.PHONY: copy
|
||||
copy: $(COPY_TARGETS)
|
||||
cp Makefile.ocamlc $(BOOT)/Makefile
|
||||
|
||||
.PHONY: ocamlrun
|
||||
ocamlrun: $(OCAMLRUN)
|
||||
@ -115,9 +117,11 @@ ocamlrun: $(OCAMLRUN)
|
||||
$(BOOT)/ocamlc: $(COPY_TARGETS)
|
||||
make -C $(OCAMLSRC)/yacc all
|
||||
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
|
||||
cd $(BOOT) && ../timed.sh ../compile_ocamlc.sh
|
||||
./timed.sh make -C _boot all
|
||||
# cd $(BOOT) && ../timed.sh ../compile_ocamlc.sh
|
||||
|
||||
.PHONY: test-compiler
|
||||
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
|
||||
|
||||
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
|
||||
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)
|
||||
LEXOBJS=$(COMMONOBJS) $(LEXOBJS1) lex/lexer.ml $(LEXOBJS2)
|
||||
@ -41,6 +43,9 @@ cvt_emit.byte: $(COMMONOBJS) cvt_emit.ml
|
||||
interp.byte: $(INTERPOBJS)
|
||||
$(MINIML) $(INTERPOBJS) -o $@
|
||||
|
||||
makedepend.byte: $(DEPENDOBJS)
|
||||
$(MINIML) $(DEPENDOBJS) -o $@
|
||||
|
||||
interpopt.opt: $(INTERPOBJS) interp.byte
|
||||
./genfileopt.sh
|
||||
@echo "Compiling interpopt.opt, this make take a while..."
|
||||
|
||||
@ -1,2 +1,3 @@
|
||||
let fast = ref false
|
||||
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)
|
||||
|
||||
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 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 bprintf b fmt = kbprintf (fun _ -> ()) b 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
|
||||
List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
|
||||
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 =
|
||||
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_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_endline s = print_string s; print_newline ()
|
||||
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 rename : string -> string -> unit = "caml_sys_rename"
|
||||
external remove: string -> unit = "caml_sys_remove"
|
||||
external readdir : string -> string array = "caml_sys_read_directory"
|
||||
|
||||
let os_type = ""
|
||||
let ocaml_version = "camlboot"
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user