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

merge branches/located_errors 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@11228 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Jacques Garrigue 2011-10-21 03:26:35 +00:00
parent efa8d8896d 8ae65cc68c
commit b1f8048f39
23 changed files with 191 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
.depend
View File

@ -26,7 +26,6 @@ utils/warnings.cmo: utils/warnings.cmi
utils/warnings.cmx: utils/warnings.cmi
parsing/asttypes.cmi:
parsing/lexer.cmi: parsing/parser.cmi parsing/location.cmi
parsing/linenum.cmi:
parsing/location.cmi: utils/warnings.cmi
parsing/longident.cmi:
parsing/parse.cmi: parsing/parsetree.cmi
@ -39,12 +38,12 @@ parsing/lexer.cmo: utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \
parsing/location.cmi parsing/lexer.cmi
parsing/lexer.cmx: utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \
parsing/location.cmx parsing/lexer.cmi
parsing/linenum.cmo: utils/misc.cmi parsing/linenum.cmi
parsing/linenum.cmx: utils/misc.cmx parsing/linenum.cmi
parsing/linenum.cmo: utils/misc.cmi
parsing/linenum.cmx: utils/misc.cmx
parsing/location.cmo: utils/warnings.cmi utils/terminfo.cmi \
parsing/linenum.cmi parsing/location.cmi
parsing/location.cmi
parsing/location.cmx: utils/warnings.cmx utils/terminfo.cmx \
parsing/linenum.cmx parsing/location.cmi
parsing/location.cmi
parsing/longident.cmo: utils/misc.cmi parsing/longident.cmi
parsing/longident.cmx: utils/misc.cmx parsing/longident.cmi
parsing/parse.cmo: parsing/syntaxerr.cmi parsing/parser.cmi \
@ -65,8 +64,8 @@ parsing/syntaxerr.cmo: parsing/location.cmi parsing/syntaxerr.cmi
parsing/syntaxerr.cmx: parsing/location.cmx parsing/syntaxerr.cmi
typing/annot.cmi: parsing/location.cmi
typing/btype.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
typing/ctype.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi \
typing/env.cmi parsing/asttypes.cmi
typing/ctype.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \
typing/ident.cmi typing/env.cmi parsing/asttypes.cmi
typing/datarepr.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
typing/env.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \
typing/ident.cmi utils/consistbl.cmi typing/annot.cmi
@ -82,7 +81,7 @@ typing/mtype.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi \
typing/oprint.cmi: typing/outcometree.cmi
typing/outcometree.cmi: parsing/asttypes.cmi
typing/parmatch.cmi: typing/types.cmi typing/typedtree.cmi \
parsing/location.cmi typing/env.cmi
parsing/parsetree.cmi parsing/location.cmi typing/env.cmi
typing/path.cmi: typing/ident.cmi
typing/predef.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi
typing/primitive.cmi:
@ -104,8 +103,8 @@ typing/typedtree.cmi: typing/types.cmi typing/primitive.cmi typing/path.cmi \
typing/typemod.cmi: typing/types.cmi typing/typedtree.cmi \
parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
typing/includemod.cmi typing/ident.cmi typing/env.cmi
typing/types.cmi: typing/primitive.cmi typing/path.cmi typing/ident.cmi \
parsing/asttypes.cmi
typing/types.cmi: typing/primitive.cmi typing/path.cmi parsing/location.cmi \
typing/ident.cmi parsing/asttypes.cmi
typing/typetexp.cmi: typing/types.cmi typing/path.cmi parsing/parsetree.cmi \
parsing/longident.cmi parsing/location.cmi typing/env.cmi
typing/unused_var.cmi: parsing/parsetree.cmi
@ -114,15 +113,17 @@ typing/btype.cmo: typing/types.cmi typing/path.cmi utils/misc.cmi \
typing/btype.cmx: typing/types.cmx typing/path.cmx utils/misc.cmx \
typing/btype.cmi
typing/ctype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
utils/misc.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \
utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/ctype.cmi
utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
typing/ident.cmi typing/env.cmi utils/clflags.cmi typing/btype.cmi \
parsing/asttypes.cmi typing/ctype.cmi
typing/ctype.cmx: typing/types.cmx typing/subst.cmx typing/path.cmx \
utils/misc.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \
utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/ctype.cmi
utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
typing/ident.cmx typing/env.cmx utils/clflags.cmx typing/btype.cmx \
parsing/asttypes.cmi typing/ctype.cmi
typing/datarepr.cmo: typing/types.cmi typing/predef.cmi utils/misc.cmi \
parsing/asttypes.cmi typing/datarepr.cmi
typing/btype.cmi parsing/asttypes.cmi typing/datarepr.cmi
typing/datarepr.cmx: typing/types.cmx typing/predef.cmx utils/misc.cmx \
parsing/asttypes.cmi typing/datarepr.cmi
typing/btype.cmx parsing/asttypes.cmi typing/datarepr.cmi
typing/env.cmo: typing/types.cmi utils/tbl.cmi typing/subst.cmi \
typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \
@ -147,12 +148,14 @@ typing/includecore.cmx: typing/types.cmx typing/typedtree.cmx \
typing/btype.cmx parsing/asttypes.cmi typing/includecore.cmi
typing/includemod.cmo: typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \
typing/subst.cmi typing/printtyp.cmi typing/path.cmi typing/mtype.cmi \
utils/misc.cmi typing/includecore.cmi typing/includeclass.cmi \
typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/includemod.cmi
utils/misc.cmi parsing/location.cmi typing/includecore.cmi \
typing/includeclass.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
utils/clflags.cmi typing/includemod.cmi
typing/includemod.cmx: typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \
typing/subst.cmx typing/printtyp.cmx typing/path.cmx typing/mtype.cmx \
utils/misc.cmx typing/includecore.cmx typing/includeclass.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/includemod.cmi
utils/misc.cmx parsing/location.cmx typing/includecore.cmx \
typing/includeclass.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
utils/clflags.cmx typing/includemod.cmi
typing/mtype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \
typing/btype.cmi parsing/asttypes.cmi typing/mtype.cmi
@ -164,21 +167,21 @@ typing/oprint.cmo: typing/outcometree.cmi parsing/asttypes.cmi \
typing/oprint.cmx: typing/outcometree.cmi parsing/asttypes.cmi \
typing/oprint.cmi
typing/parmatch.cmo: utils/warnings.cmi typing/types.cmi typing/typedtree.cmi \
typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \
parsing/location.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \
typing/ctype.cmi typing/btype.cmi parsing/asttypes.cmi \
typing/parmatch.cmi
typing/subst.cmi typing/predef.cmi typing/path.cmi parsing/parsetree.cmi \
utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
typing/ident.cmi typing/env.cmi typing/datarepr.cmi typing/ctype.cmi \
typing/btype.cmi parsing/asttypes.cmi typing/parmatch.cmi
typing/parmatch.cmx: utils/warnings.cmx typing/types.cmx typing/typedtree.cmx \
typing/subst.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \
parsing/location.cmx typing/ident.cmx typing/env.cmx typing/datarepr.cmx \
typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \
typing/parmatch.cmi
typing/subst.cmx typing/predef.cmx typing/path.cmx parsing/parsetree.cmi \
utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
typing/ident.cmx typing/env.cmx typing/datarepr.cmx typing/ctype.cmx \
typing/btype.cmx parsing/asttypes.cmi typing/parmatch.cmi
typing/path.cmo: typing/ident.cmi typing/path.cmi
typing/path.cmx: typing/ident.cmx typing/path.cmi
typing/predef.cmo: typing/types.cmi typing/path.cmi typing/ident.cmi \
typing/btype.cmi parsing/asttypes.cmi typing/predef.cmi
typing/predef.cmx: typing/types.cmx typing/path.cmx typing/ident.cmx \
typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi
typing/predef.cmo: typing/types.cmi typing/path.cmi parsing/location.cmi \
typing/ident.cmi typing/btype.cmi parsing/asttypes.cmi typing/predef.cmi
typing/predef.cmx: typing/types.cmx typing/path.cmx parsing/location.cmx \
typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi
typing/primitive.cmo: utils/misc.cmi typing/primitive.cmi
typing/primitive.cmx: utils/misc.cmx typing/primitive.cmi
typing/printtyp.cmo: typing/types.cmi typing/primitive.cmi typing/predef.cmi \
@ -196,9 +199,11 @@ typing/stypes.cmo: typing/typedtree.cmi typing/printtyp.cmi \
typing/stypes.cmx: typing/typedtree.cmx typing/printtyp.cmx \
parsing/location.cmx utils/clflags.cmx typing/annot.cmi typing/stypes.cmi
typing/subst.cmo: typing/types.cmi utils/tbl.cmi typing/path.cmi \
utils/misc.cmi typing/ident.cmi typing/btype.cmi typing/subst.cmi
utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/btype.cmi \
typing/subst.cmi
typing/subst.cmx: typing/types.cmx utils/tbl.cmx typing/path.cmx \
utils/misc.cmx typing/ident.cmx typing/btype.cmx typing/subst.cmi
utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/btype.cmx \
typing/subst.cmi
typing/typeclass.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/predef.cmi \
@ -249,26 +254,28 @@ typing/typedtree.cmo: typing/types.cmi typing/primitive.cmi typing/path.cmi \
typing/typedtree.cmx: typing/types.cmx typing/primitive.cmx typing/path.cmx \
utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \
parsing/asttypes.cmi typing/typedtree.cmi
typing/typemod.cmo: typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \
typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/path.cmi \
parsing/parsetree.cmi typing/mtype.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \
typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
typing/typemod.cmi
typing/typemod.cmx: typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \
typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx typing/path.cmx \
parsing/parsetree.cmi typing/mtype.cmx utils/misc.cmx \
parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
typing/typemod.cmi
typing/typemod.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
typing/typeclass.cmi typing/subst.cmi typing/stypes.cmi \
typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi \
typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \
parsing/location.cmi typing/includemod.cmi typing/ident.cmi \
typing/env.cmi typing/ctype.cmi utils/config.cmi utils/clflags.cmi \
typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi typing/typemod.cmi
typing/typemod.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
typing/typedtree.cmx typing/typedecl.cmx typing/typecore.cmx \
typing/typeclass.cmx typing/subst.cmx typing/stypes.cmx \
typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi \
typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \
parsing/location.cmx typing/includemod.cmx typing/ident.cmx \
typing/env.cmx typing/ctype.cmx utils/config.cmx utils/clflags.cmx \
typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi typing/typemod.cmi
typing/types.cmo: typing/primitive.cmi typing/path.cmi utils/misc.cmi \
typing/ident.cmi parsing/asttypes.cmi typing/types.cmi
parsing/location.cmi typing/ident.cmi parsing/asttypes.cmi \
typing/types.cmi
typing/types.cmx: typing/primitive.cmx typing/path.cmx utils/misc.cmx \
typing/ident.cmx parsing/asttypes.cmi typing/types.cmi
parsing/location.cmx typing/ident.cmx parsing/asttypes.cmi \
typing/types.cmi
typing/typetexp.cmo: utils/warnings.cmi typing/types.cmi utils/tbl.cmi \
typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/env.cmi \
@ -406,11 +413,11 @@ bytecomp/printlambda.cmx: typing/types.cmx typing/primitive.cmx \
parsing/asttypes.cmi bytecomp/printlambda.cmi
bytecomp/runtimedef.cmo: bytecomp/runtimedef.cmi
bytecomp/runtimedef.cmx: bytecomp/runtimedef.cmi
bytecomp/simplif.cmo: typing/stypes.cmi bytecomp/lambda.cmi typing/ident.cmi \
utils/clflags.cmi parsing/asttypes.cmi typing/annot.cmi \
bytecomp/simplif.cmo: utils/tbl.cmi typing/stypes.cmi bytecomp/lambda.cmi \
typing/ident.cmi utils/clflags.cmi parsing/asttypes.cmi typing/annot.cmi \
bytecomp/simplif.cmi
bytecomp/simplif.cmx: typing/stypes.cmx bytecomp/lambda.cmx typing/ident.cmx \
utils/clflags.cmx parsing/asttypes.cmi typing/annot.cmi \
bytecomp/simplif.cmx: utils/tbl.cmx typing/stypes.cmx bytecomp/lambda.cmx \
typing/ident.cmx utils/clflags.cmx parsing/asttypes.cmi typing/annot.cmi \
bytecomp/simplif.cmi
bytecomp/switch.cmo: bytecomp/switch.cmi
bytecomp/switch.cmx: bytecomp/switch.cmi
@ -488,8 +495,8 @@ asmcomp/cmx_format.cmi: asmcomp/clambda.cmi
asmcomp/codegen.cmi: asmcomp/cmm.cmi
asmcomp/coloring.cmi:
asmcomp/comballoc.cmi: asmcomp/mach.cmi
asmcomp/compilenv.cmi: typing/ident.cmi asmcomp/cmx_format.cmi \
asmcomp/clambda.cmi
asmcomp/compilenv.cmi: bytecomp/lambda.cmi typing/ident.cmi \
asmcomp/cmx_format.cmi asmcomp/clambda.cmi
asmcomp/debuginfo.cmi: parsing/location.cmi bytecomp/lambda.cmi
asmcomp/emit.cmi: asmcomp/linearize.cmi asmcomp/cmm.cmi
asmcomp/emitaux.cmi: asmcomp/debuginfo.cmi
@ -606,12 +613,12 @@ asmcomp/comballoc.cmo: asmcomp/reg.cmi asmcomp/mach.cmi utils/config.cmi \
asmcomp/arch.cmo asmcomp/comballoc.cmi
asmcomp/comballoc.cmx: asmcomp/reg.cmx asmcomp/mach.cmx utils/config.cmx \
asmcomp/arch.cmx asmcomp/comballoc.cmi
asmcomp/compilenv.cmo: utils/misc.cmi typing/ident.cmi typing/env.cmi \
utils/config.cmi asmcomp/cmx_format.cmi asmcomp/clambda.cmi \
asmcomp/compilenv.cmi
asmcomp/compilenv.cmx: utils/misc.cmx typing/ident.cmx typing/env.cmx \
utils/config.cmx asmcomp/cmx_format.cmi asmcomp/clambda.cmx \
asmcomp/compilenv.cmi
asmcomp/compilenv.cmo: utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \
typing/env.cmi utils/config.cmi asmcomp/cmx_format.cmi \
asmcomp/clambda.cmi asmcomp/compilenv.cmi
asmcomp/compilenv.cmx: utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \
typing/env.cmx utils/config.cmx asmcomp/cmx_format.cmi \
asmcomp/clambda.cmx asmcomp/compilenv.cmi
asmcomp/debuginfo.cmo: parsing/location.cmi bytecomp/lambda.cmi \
asmcomp/debuginfo.cmi
asmcomp/debuginfo.cmx: parsing/location.cmx bytecomp/lambda.cmx \

1
Makefile
View File

@ -113,6 +113,7 @@ OPTOBJS=$(OPTUTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) $(OPTDRIVER)
EXPUNGEOBJS=utils/misc.cmo utils/tbl.cmo \
utils/config.cmo utils/clflags.cmo \
typing/ident.cmo typing/path.cmo typing/types.cmo typing/btype.cmo \
utils/warnings.cmo parsing/linenum.cmo parsing/location.cmo \
typing/predef.cmo bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \
bytecomp/dll.cmo bytecomp/meta.cmo bytecomp/symtable.cmo toplevel/expunge.cmo

BIN
boot/ocamlc
View File

Binary file not shown.

BIN
boot/ocamldep
View File

Binary file not shown.

BIN
boot/ocamllex
View File

Binary file not shown.

4
bytecomp/translcore.ml
View File

@ -481,7 +481,9 @@ let rec push_defaults loc bindings pat_expr_list partial =
Texp_match
({exp with exp_type = pat.pat_type; exp_desc =
Texp_ident (Path.Pident param,
{val_type = pat.pat_type; val_kind = Val_reg})},
{val_type = pat.pat_type; val_kind = Val_reg;
val_loc = Location.none;
})},
pat_expr_list, partial) }
in
push_defaults loc bindings

6
debugger/Makefile.shared
View File

@ -29,9 +29,9 @@ INCLUDES=\
OTHEROBJS=\
$(UNIXDIR)/unix.cma \
../utils/misc.cmo ../utils/config.cmo \
../utils/tbl.cmo ../utils/clflags.cmo ../utils/consistbl.cmo \
../parsing/longident.cmo \
../utils/misc.cmo ../utils/config.cmo ../utils/tbl.cmo \
../utils/clflags.cmo ../utils/consistbl.cmo ../utils/warnings.cmo \
../parsing/location.cmo ../parsing/longident.cmo \
../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \
../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
../typing/subst.cmo ../typing/predef.cmo \

1
otherlibs/labltk/browser/.ignore
View File

@ -1,2 +1,3 @@
ocamlbrowser
dummy.mli
help.ml

3
otherlibs/labltk/browser/searchpos.ml
View File

@ -495,7 +495,8 @@ and view_expr_type ?title ?path ?env ?(name="noname") t =
| Some path -> parent_path path, ident_of_path path ~default:name
in
view_signature ~title ?path ?env
[Tsig_value (id, {val_type = t; val_kind = Val_reg})]
[Tsig_value (id, {val_type = t; val_kind = Val_reg;
val_loc = Location.none})]
and view_decl lid ~kind ~env =
match kind with

12
parsing/location.ml
View File

@ -207,7 +207,7 @@ let get_pos_info pos =
(pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
;;
let print ppf loc =
let print_loc ppf loc =
let (file, line, startchar) = get_pos_info loc.loc_start in
let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
if file = "//toplevel//" then begin
@ -217,11 +217,15 @@ let print ppf loc =
end else begin
fprintf ppf "%s%s%s%i" msg_file file msg_line line;
if startchar >= 0 then
fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar;
fprintf ppf "%s@.%s" msg_colon msg_head;
fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar
end
;;
let print ppf loc =
if loc.loc_start.pos_fname = "//toplevel//"
&& highlight_locations ppf loc none then ()
else fprintf ppf "%a%s@.%s" print_loc loc msg_colon msg_head
let print_error ppf loc =
print ppf loc;
fprintf ppf "Error: ";
@ -235,7 +239,7 @@ let print_warning loc ppf w =
let n = Warnings.print ppf w in
num_loc_lines := !num_loc_lines + n
in
fprintf ppf "%a" print loc;
print ppf loc;
fprintf ppf "Warning %a@." printw w;
pp_print_flush ppf ();
incr num_loc_lines;

5
parsing/location.mli
View File

@ -46,7 +46,8 @@ val rhs_loc: int -> t
val input_name: string ref
val input_lexbuf: Lexing.lexbuf option ref
val get_pos_info : Lexing.position -> string * int * int (* file, line, char *)
val get_pos_info: Lexing.position -> string * int * int (* file, line, char *)
val print_loc: formatter -> t -> unit
val print_error: formatter -> t -> unit
val print_error_cur_file: formatter -> unit
val print_warning: t -> formatter -> Warnings.t -> unit
@ -55,3 +56,5 @@ val echo_eof: unit -> unit
val reset: unit -> unit
val highlight_locations: formatter -> t -> t -> bool
val print: formatter -> t -> unit

2
typing/ctype.ml
View File

@ -1015,6 +1015,7 @@ let new_declaration newtype manifest =
type_manifest = manifest;
type_variance = [];
type_newtype_level = newtype;
type_loc = Location.none;
}
let instance_constructor ?in_pattern cstr =
@ -4055,6 +4056,7 @@ let nondep_type_decl env mid id is_covariant decl =
type_private = priv;
type_variance = decl.type_variance;
type_newtype_level = None;
type_loc = decl.type_loc;
}
with Not_found ->
clear_hash ();

18
typing/includemod.ml
View File

@ -336,20 +336,30 @@ let type_declarations env id decl1 decl2 =
open Format
open Printtyp
let show_loc msg ppf loc =
let pos = loc.Location.loc_start in
if List.mem pos.Lexing.pos_fname [""; "_none_"] then ()
else fprintf ppf "@\n@[%a: %s@]" Location.print_loc loc msg
let show_locs ppf (loc1, loc2) =
show_loc "Expected declaration" ppf loc2;
show_loc "Actual declaration" ppf loc1
let include_err ppf = function
| Missing_field id ->
fprintf ppf "The field `%a' is required but not provided" ident id
| Value_descriptions(id, d1, d2) ->
fprintf ppf
"@[<hv 2>Values do not match:@ \
%a@;<1 -2>is not included in@ %a@]"
(value_description id) d1 (value_description id) d2
"@[<hv 2>Values do not match:@ %a@;<1 -2>is not included in@ %a@]"
(value_description id) d1 (value_description id) d2;
show_locs ppf (d1.val_loc, d2.val_loc);
| Type_declarations(id, d1, d2, errs) ->
fprintf ppf "@[@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a@]"
fprintf ppf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
"Type declarations do not match"
(type_declaration id) d1
"is not included in"
(type_declaration id) d2
show_locs (d1.type_loc, d2.type_loc)
(Includecore.report_type_mismatch
"the first" "the second" "declaration") errs
| Exception_declarations(id, d1, d2) ->

4
typing/mtype.ml
View File

@ -110,7 +110,9 @@ let nondep_supertype env mid mty =
match item with
Tsig_value(id, d) ->
Tsig_value(id, {val_type = Ctype.nondep_type env mid d.val_type;
val_kind = d.val_kind}) :: rem'
val_kind = d.val_kind;
val_loc = d.val_loc;
}) :: rem'
| Tsig_type(id, d, rs) ->
Tsig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d, rs)
:: rem'

9
typing/predef.ml
View File

@ -89,6 +89,7 @@ let build_initial_env add_type add_exception empty_env =
{type_params = [];
type_arity = 0;
type_kind = Type_abstract;
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [];
@ -97,6 +98,7 @@ let build_initial_env add_type add_exception empty_env =
{type_params = [];
type_arity = 0;
type_kind = Type_variant(["false", [], None; "true", [], None]);
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [];
@ -105,6 +107,7 @@ let build_initial_env add_type add_exception empty_env =
{type_params = [];
type_arity = 0;
type_kind = Type_variant(["()", [], None]);
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [];
@ -113,6 +116,7 @@ let build_initial_env add_type add_exception empty_env =
{type_params = [];
type_arity = 0;
type_kind = Type_variant [];
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [];
@ -122,6 +126,7 @@ let build_initial_env add_type add_exception empty_env =
{type_params = [tvar];
type_arity = 1;
type_kind = Type_abstract;
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [true, true, true];
@ -132,6 +137,7 @@ let build_initial_env add_type add_exception empty_env =
type_arity = 1;
type_kind =
Type_variant(["[]", [], None; "::", [tvar; type_list tvar], None]);
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [true, false, false];
@ -143,6 +149,7 @@ let build_initial_env add_type add_exception empty_env =
];
type_arity = 6;
type_kind = Type_abstract;
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [
@ -156,6 +163,7 @@ let build_initial_env add_type add_exception empty_env =
{type_params = [tvar];
type_arity = 1;
type_kind = Type_variant(["None", [], None; "Some", [tvar], None]);
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [true, false, false];
@ -165,6 +173,7 @@ let build_initial_env add_type add_exception empty_env =
{type_params = [tvar];
type_arity = 1;
type_kind = Type_abstract;
type_loc = Location.none;
type_private = Public;
type_manifest = None;
type_variance = [true, false, false];

7
typing/subst.ml
View File

@ -180,9 +180,7 @@ let type_declaration s decl =
(List.map (fun (n, mut, arg) -> (n, mut, typexp s arg)) lbls,
rep)
end;
type_manifest =
begin
match decl.type_manifest with
None -> None
@ -191,6 +189,7 @@ let type_declaration s decl =
type_private = decl.type_private;
type_variance = decl.type_variance;
type_newtype_level = None;
type_loc = decl.type_loc;
}
in
cleanup_types ();
@ -249,7 +248,9 @@ let class_type s cty =
let value_description s descr =
{ val_type = type_expr s descr.val_type;
val_kind = descr.val_kind }
val_kind = descr.val_kind;
val_loc = descr.val_loc;
}
let exception_declaration s tyl =
List.map (type_expr s) tyl

23
typing/typeclass.ml
View File

@ -194,11 +194,11 @@ let rc node =
(* Enter a value in the method environment only *)
let enter_met_env lab kind ty val_env met_env par_env =
let (id, val_env) =
Env.enter_value lab {val_type = ty; val_kind = Val_unbound} val_env
Env.enter_value lab {val_type = ty; val_kind = Val_unbound; val_loc = Location.none} val_env
in
(id, val_env,
Env.add_value id {val_type = ty; val_kind = kind} met_env,
Env.add_value id {val_type = ty; val_kind = Val_unbound} par_env)
Env.add_value id {val_type = ty; val_kind = kind; val_loc = Location.none} met_env,
Env.add_value id {val_type = ty; val_kind = Val_unbound; val_loc = Location.none} par_env)
(* Enter an instance variable in the environment *)
let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc =
@ -584,7 +584,9 @@ let rec class_field cl_num self_type meths vars
in
let desc =
{val_type = expr.exp_type;
val_kind = Val_ivar (Immutable, cl_num)}
val_kind = Val_ivar (Immutable, cl_num);
val_loc = Location.none;
}
in
let id' = Ident.create (Ident.name id) in
((id', expr)
@ -937,7 +939,9 @@ and class_expr cl_num val_env met_env scl =
Ctype.generalize expr.exp_type;
let desc =
{val_type = expr.exp_type; val_kind = Val_ivar (Immutable,
cl_num)}
cl_num);
val_loc = Location.none;
}
in
let id' = Ident.create (Ident.name id) in
((id', expr)
@ -1021,7 +1025,8 @@ let temp_abbrev env id arity =
type_manifest = Some ty;
type_variance = List.map (fun _ -> true, true, true) !params;
type_newtype_level = None;
}
type_loc = Location.none;
}
env
in
(!params, ty, env)
@ -1235,7 +1240,7 @@ let class_infos define_class kind
type_manifest = Some obj_ty;
type_variance = List.map (fun _ -> true, true, true) obj_params;
type_newtype_level = None;
}
type_loc = cl.pci_loc}
in
let (cl_params, cl_ty) =
Ctype.instance_parameterized_type params (Ctype.self_type typ)
@ -1249,8 +1254,8 @@ let class_infos define_class kind
type_private = Public;
type_manifest = Some cl_ty;
type_variance = List.map (fun _ -> true, true, true) cl_params;
type_newtype_level = None
}
type_newtype_level = None;
type_loc = cl.pci_loc}
in
((cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
arity, pub_meths, List.rev !coercion_locs, expr) :: res,

34
typing/typecore.ml
View File

@ -742,7 +742,7 @@ let add_pattern_variables env =
let pv = get_ref pattern_variables in
(List.fold_right
(fun (id, ty, loc) env ->
let e1 = Env.add_value id {val_type = ty; val_kind = Val_reg} env in
let e1 = Env.add_value id {val_type = ty; val_kind = Val_reg; val_loc = loc} env in
Env.add_annot id (Annot.Iref_internal loc) e1
)
pv env,
@ -774,11 +774,13 @@ let type_class_arg_pattern cl_num val_env met_env l spat =
if is_optional l then unify_pat val_env pat (type_option (newvar ()));
let (pv, met_env) =
List.fold_right
(fun (id, ty, _loc) (pv, env) ->
(fun (id, ty, loc) (pv, env) ->
let id' = Ident.create (Ident.name id) in
((id', id, ty)::pv,
Env.add_value id' {val_type = ty;
val_kind = Val_ivar (Immutable, cl_num)}
val_kind = Val_ivar (Immutable, cl_num);
val_loc = loc;
}
env))
!pattern_variables ([], met_env)
in
@ -802,12 +804,19 @@ let type_self_pattern cl_num privty val_env met_env par_env spat =
pattern_variables := [];
let (val_env, met_env, par_env) =
List.fold_right
(fun (id, ty, _loc) (val_env, met_env, par_env) ->
(Env.add_value id {val_type = ty; val_kind = Val_unbound} val_env,
(fun (id, ty, loc) (val_env, met_env, par_env) ->
(Env.add_value id {val_type = ty;
val_kind = Val_unbound;
val_loc = loc;
} val_env,
Env.add_value id {val_type = ty;
val_kind = Val_self (meths, vars, cl_num, privty)}
val_kind = Val_self (meths, vars, cl_num, privty);
val_loc = loc;
}
met_env,
Env.add_value id {val_type = ty; val_kind = Val_unbound} par_env))
Env.add_value id {val_type = ty; val_kind = Val_unbound;
val_loc = loc;
} par_env))
pv (val_env, met_env, par_env)
in
(pat, meths, vars, val_env, met_env, par_env)
@ -1627,7 +1636,9 @@ and type_expect ?in_function env sexp ty_expected =
let high = type_expect env shigh Predef.type_int in
let (id, new_env) =
Env.enter_value param {val_type = instance Predef.type_int;
val_kind = Val_reg} env in
val_kind = Val_reg;
val_loc = loc;
} env in
let body = type_statement new_env sbody in
rue {
exp_desc = Texp_for(id, low, high, dir, body);
@ -1768,7 +1779,9 @@ and type_expect ?in_function env sexp ty_expected =
unify env res_ty (instance typ);
(Texp_apply({ exp_desc = Texp_ident(Path.Pident method_id,
{val_type = method_type;
val_kind = Val_reg});
val_kind = Val_reg;
val_loc = Location.none;
});
exp_loc = loc;
exp_type = method_type;
exp_env = env },
@ -1997,6 +2010,7 @@ and type_expect ?in_function env sexp ty_expected =
type_manifest = None;
type_variance = [];
type_newtype_level = Some (get_current_level ());
type_loc = loc;
}
in
let ty = newvar () in
@ -2149,7 +2163,7 @@ and type_argument env sarg ty_expected' ty_expected =
{pat_desc = Tpat_var id; pat_type = ty;
pat_loc = Location.none; pat_env = env},
{exp_type = ty; exp_loc = Location.none; exp_env = env; exp_desc =
Texp_ident(Path.Pident id,{val_type = ty; val_kind = Val_reg})}
Texp_ident(Path.Pident id,{val_type = ty; val_kind = Val_reg; val_loc = Location.none})}
in
let eta_pat, eta_var = var_pair "eta" ty_arg in
let func texp =

13
typing/typedecl.ml
View File

@ -60,6 +60,7 @@ let enter_type env (name, sdecl) id =
| Some _ -> Some(Ctype.newvar ()) end;
type_variance = List.map (fun _ -> true, true, true) sdecl.ptype_params;
type_newtype_level = None;
type_loc = sdecl.ptype_loc;
}
in
Env.add_type id decl env
@ -220,6 +221,7 @@ let transl_declaration env (name, sdecl) id =
end;
type_variance = List.map (fun _ -> true, true, true) params;
type_newtype_level = None;
type_loc = sdecl.ptype_loc;
} in
(* Check constraints *)
@ -827,11 +829,11 @@ let transl_exn_rebind env loc lid =
| _ -> raise(Error(loc, Not_an_exception lid))
(* Translate a value declaration *)
let transl_value_decl env valdecl =
let transl_value_decl env loc valdecl =
let ty = Typetexp.transl_type_scheme env valdecl.pval_type in
match valdecl.pval_prim with
[] ->
{ val_type = ty; val_kind = Val_reg }
{ val_type = ty; val_kind = Val_reg; val_loc = loc }
| decl ->
let arity = Ctype.arity ty in
if arity = 0 then
@ -841,7 +843,7 @@ let transl_value_decl env valdecl =
&& prim.prim_arity > 5
&& prim.prim_native_name = ""
then raise(Error(valdecl.pval_type.ptyp_loc, Missing_native_external));
{ val_type = ty; val_kind = Val_prim prim }
{ val_type = ty; val_kind = Val_prim prim; val_loc = loc }
(* Translate a "with" constraint -- much simplified version of
transl_type_decl. *)
@ -875,6 +877,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
end;
type_variance = [];
type_newtype_level = None;
type_loc = sdecl.ptype_loc;
}
in
begin match row_path with None -> ()
@ -905,7 +908,9 @@ let abstract_type_decl arity =
type_private = Public;
type_manifest = None;
type_variance = replicate_list (true, true, true) arity;
type_newtype_level = None; } in
type_newtype_level = None;
type_loc = Location.none;
} in
Ctype.end_def();
generalize_decl decl;
decl

2
typing/typedecl.mli
View File

@ -27,7 +27,7 @@ val transl_exn_rebind:
Env.t -> Location.t -> Longident.t -> Path.t * exception_declaration
val transl_value_decl:
Env.t -> Parsetree.value_description -> value_description
Env.t -> Location.t -> Parsetree.value_description -> value_description
val transl_with_constraint:
Env.t -> Ident.t -> Path.t option -> type_declaration ->

9
typing/typemod.ml
View File

@ -123,7 +123,8 @@ let merge_constraint initial_env loc sg lid constr =
type_variance =
List.map (fun (c,n) -> (not n, not c, not c))
sdecl.ptype_variance;
type_newtype_level = None}
type_loc = Location.none;
type_newtype_level = None }
and id_row = Ident.create (s^"#row") in
let initial_env = Env.add_type id_row decl_row initial_env in
let newdecl = Typedecl.transl_with_constraint
@ -380,7 +381,7 @@ and transl_signature env sg =
| item :: srem ->
match item.psig_desc with
| Psig_value(name, sdesc) ->
let desc = Typedecl.transl_value_decl env sdesc in
let desc = Typedecl.transl_value_decl env item.psig_loc sdesc in
let (id, newenv) = Env.enter_value name desc env in
let rem = transl_sig newenv srem in
if List.exists (Ident.equal id) (get_values rem) then rem
@ -809,8 +810,8 @@ and type_structure funct_body anchor env sstr scope =
(Tstr_value(rec_flag, defs) :: str_rem,
map_end make_sig_value bound_idents sig_rem,
final_env)
| {pstr_desc = Pstr_primitive(name, sdesc)} :: srem ->
let desc = Typedecl.transl_value_decl env sdesc in
| {pstr_desc = Pstr_primitive(name, sdesc); pstr_loc = loc} :: srem ->
let desc = Typedecl.transl_value_decl env loc sdesc in
let (id, newenv) = Env.enter_value name desc env in
let (str_rem, sig_rem, final_env) = type_struct newenv srem in
(Tstr_primitive(id, desc) :: str_rem,

10
typing/types.ml
View File

@ -87,7 +87,9 @@ module Vars = Meths
type value_description =
{ val_type: type_expr; (* Type of the value *)
val_kind: value_kind }
val_kind: value_kind;
val_loc: Location.t;
}
and value_kind =
Val_reg (* Regular value *)
@ -146,8 +148,10 @@ type type_declaration =
type_private: private_flag;
type_manifest: type_expr option;
type_variance: (bool * bool * bool) list;
type_newtype_level: int option }
(* covariant, contravariant, weakly contravariant *)
(* covariant, contravariant, weakly contravariant *)
type_newtype_level: int option;
type_loc: Location.t;
}
and type_kind =
Type_abstract

9
typing/types.mli
View File

@ -85,7 +85,9 @@ module Vars : Map.S with type key = string
type value_description =
{ val_type: type_expr; (* Type of the value *)
val_kind: value_kind }
val_kind: value_kind;
val_loc: Location.t;
}
and value_kind =
Val_reg (* Regular value *)
@ -144,8 +146,9 @@ type type_declaration =
type_manifest: type_expr option;
type_variance: (bool * bool * bool) list;
(* covariant, contravariant, weakly contravariant *)
type_newtype_level: int option }
type_newtype_level: int option;
type_loc: Location.t;
}
and type_kind =
Type_abstract