Browse files

Adding locations to Longident.t

  • Loading branch information...
1 parent 4359d0d commit 628322601b0dffd1a1db4146dc57c6792c110cff Tiphaine Turpin committed Jun 30, 2011
View
90 .depend
@@ -28,9 +28,9 @@ 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/longident.cmi: parsing/location.cmi
parsing/parse.cmi: parsing/parsetree.cmi
-parsing/parser.cmi: parsing/parsetree.cmi
+parsing/parser.cmi: parsing/parsetree.cmi parsing/longident.cmi
parsing/parsetree.cmi: parsing/longident.cmi parsing/location.cmi \
parsing/asttypes.cmi
parsing/pprintast.cmi: parsing/parsetree.cmi
@@ -46,8 +46,10 @@ parsing/location.cmo: utils/warnings.cmi utils/terminfo.cmi \
parsing/linenum.cmi parsing/location.cmi
parsing/location.cmx: utils/warnings.cmx utils/terminfo.cmx \
parsing/linenum.cmx parsing/location.cmi
-parsing/longident.cmo: utils/misc.cmi parsing/longident.cmi
-parsing/longident.cmx: utils/misc.cmx parsing/longident.cmi
+parsing/longident.cmo: utils/misc.cmi parsing/location.cmi \
+ parsing/longident.cmi
+parsing/longident.cmx: utils/misc.cmx parsing/location.cmx \
+ parsing/longident.cmi
parsing/parse.cmo: parsing/syntaxerr.cmi parsing/parser.cmi \
parsing/location.cmi parsing/lexer.cmi parsing/parse.cmi
parsing/parse.cmx: parsing/syntaxerr.cmx parsing/parser.cmx \
@@ -113,21 +115,21 @@ typing/types.cmi: typing/primitive.cmi typing/path.cmi typing/ident.cmi \
typing/typetexp.cmi: typing/types.cmi typing/typedtree.cmi typing/path.cmi \
parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
typing/env.cmi
-typing/typetexp_ast2src.cmi: typing/types.cmi typing/typedtree.cmi \
- typing/path.cmi parsing/parsetree.cmi parsing/longident.cmi \
- parsing/location.cmi typing/env.cmi
-typing/untypeast.cmi: typing/typedtree.cmi parsing/parsetree.cmi
+typing/untypeast.cmi: typing/typedtree.cmi typing/path.cmi \
+ parsing/parsetree.cmi parsing/longident.cmi
typing/unused_var.cmi: parsing/parsetree.cmi
typing/btype.cmo: typing/types.cmi typing/path.cmi utils/misc.cmi \
typing/btype.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/datarepr.cmx: typing/types.cmx typing/predef.cmx utils/misc.cmx \
@@ -208,12 +210,6 @@ typing/subst.cmo: typing/types.cmi utils/tbl.cmi typing/path.cmi \
utils/misc.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
-typing/ty.cmo: typing/typedtree.cmi typing/path.cmi parsing/parsetree.cmi \
- utils/misc.cmi parsing/longident.cmi typing/ident.cmi \
- parsing/asttypes.cmi
-typing/ty.cmx: typing/typedtree.cmx typing/path.cmx parsing/parsetree.cmi \
- utils/misc.cmx parsing/longident.cmx typing/ident.cmx \
- parsing/asttypes.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 \
@@ -264,20 +260,18 @@ 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: utils/warnings.cmi typing/untypeast.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 \
- parsing/pprintast.cmi typing/path.cmi parsing/parsetree.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/untypeast.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 \
- parsing/pprintast.cmx typing/path.cmx parsing/parsetree.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 \
@@ -298,10 +292,12 @@ typing/typetexp.cmx: utils/warnings.cmx typing/types.cmx typing/typedtree.cmx \
typing/typetexp.cmi
typing/untypeast.cmo: typing/typedtree.cmi typing/path.cmi \
parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
- typing/ident.cmi parsing/asttypes.cmi typing/untypeast.cmi
+ parsing/location.cmi typing/ident.cmi parsing/asttypes.cmi \
+ typing/untypeast.cmi
typing/untypeast.cmx: typing/typedtree.cmx typing/path.cmx \
parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
- typing/ident.cmx parsing/asttypes.cmi typing/untypeast.cmi
+ parsing/location.cmx typing/ident.cmx parsing/asttypes.cmi \
+ typing/untypeast.cmi
typing/unused_var.cmo: utils/warnings.cmi parsing/parsetree.cmi \
parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \
typing/unused_var.cmi
@@ -533,8 +529,8 @@ asmcomp/selectgen.cmi: utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
asmcomp/selection.cmi: asmcomp/mach.cmi asmcomp/cmm.cmi
asmcomp/spill.cmi: asmcomp/mach.cmi
asmcomp/split.cmi: asmcomp/mach.cmi
-asmcomp/arch.cmo: utils/misc.cmi utils/config.cmi
-asmcomp/arch.cmx: utils/misc.cmx utils/config.cmx
+asmcomp/arch.cmo:
+asmcomp/arch.cmx:
asmcomp/asmgen.cmo: bytecomp/translmod.cmi asmcomp/split.cmi \
asmcomp/spill.cmi asmcomp/selection.cmi asmcomp/scheduling.cmi \
asmcomp/reload.cmi asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \
@@ -638,15 +634,13 @@ asmcomp/debuginfo.cmo: parsing/location.cmi bytecomp/lambda.cmi \
asmcomp/debuginfo.cmx: parsing/location.cmx bytecomp/lambda.cmx \
asmcomp/debuginfo.cmi
asmcomp/emit.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
- asmcomp/mach.cmi parsing/location.cmi asmcomp/linearize.cmi \
- asmcomp/emitaux.cmi asmcomp/debuginfo.cmi utils/config.cmi \
- asmcomp/compilenv.cmi asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo \
- asmcomp/emit.cmi
+ asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/emitaux.cmi \
+ asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \
+ asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi
asmcomp/emit.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
- asmcomp/mach.cmx parsing/location.cmx asmcomp/linearize.cmx \
- asmcomp/emitaux.cmx asmcomp/debuginfo.cmx utils/config.cmx \
- asmcomp/compilenv.cmx asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx \
- asmcomp/emit.cmi
+ asmcomp/mach.cmx asmcomp/linearize.cmx asmcomp/emitaux.cmx \
+ asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \
+ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi
asmcomp/emitaux.cmo: asmcomp/reg.cmi asmcomp/linearize.cmi \
asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \
asmcomp/emitaux.cmi
@@ -686,17 +680,17 @@ asmcomp/printmach.cmx: asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printcmm.cmx \
asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \
asmcomp/printmach.cmi
asmcomp/proc.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
- utils/config.cmi asmcomp/cmm.cmi utils/clflags.cmi utils/ccomp.cmi \
- asmcomp/arch.cmo asmcomp/proc.cmi
+ utils/config.cmi asmcomp/cmm.cmi utils/ccomp.cmi asmcomp/arch.cmo \
+ asmcomp/proc.cmi
asmcomp/proc.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
- utils/config.cmx asmcomp/cmm.cmx utils/clflags.cmx utils/ccomp.cmx \
- asmcomp/arch.cmx asmcomp/proc.cmi
+ utils/config.cmx asmcomp/cmm.cmx utils/ccomp.cmx asmcomp/arch.cmx \
+ asmcomp/proc.cmi
asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi
asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi
asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
- asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/reload.cmi
+ asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/reload.cmi
asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \
- asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/reload.cmi
+ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/reload.cmi
asmcomp/reloadgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
asmcomp/reloadgen.cmi
asmcomp/reloadgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
@@ -717,10 +711,10 @@ asmcomp/selectgen.cmx: utils/tbl.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/selectgen.cmi
asmcomp/selection.cmo: asmcomp/selectgen.cmi asmcomp/reg.cmi asmcomp/proc.cmi \
utils/misc.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \
- asmcomp/arch.cmo asmcomp/selection.cmi
+ utils/clflags.cmi asmcomp/arch.cmo asmcomp/selection.cmi
asmcomp/selection.cmx: asmcomp/selectgen.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
utils/misc.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \
- asmcomp/arch.cmx asmcomp/selection.cmi
+ utils/clflags.cmx asmcomp/arch.cmx asmcomp/selection.cmi
asmcomp/spill.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
asmcomp/mach.cmi asmcomp/spill.cmi
asmcomp/spill.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
View
BIN boot/ocamlc
Binary file not shown.
View
BIN boot/ocamldep
Binary file not shown.
View
18 parsing/longident.ml
@@ -12,10 +12,10 @@
(* $Id$ *)
-type t =
+type lid =
Lident of string
- | Ldot of t * string
- | Lapply of t * t
+ | Ldot of lid * string
+ | Lapply of lid * lid
let rec flat accu = function
Lident s -> s :: accu
@@ -41,3 +41,15 @@ let parse s =
[] -> Lident "" (* should not happen, but don't put assert false
so as not to crash the toplevel (see Genprintval) *)
| hd :: tl -> List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl
+
+type t = {
+ lid : lid;
+ loc : Location.t
+}
+
+let flatten lid = flatten lid.lid
+let last lid = last lid.lid
+let parse loc lid = {lid = parse lid ; loc = loc}
+
+let longident loc lid = {lid = lid ; loc = loc}
+let lident loc name = longident loc (Lident name)
View
16 parsing/longident.mli
@@ -14,11 +14,19 @@
(* Long identifiers, used in parsetree. *)
-type t =
+type lid =
Lident of string
- | Ldot of t * string
- | Lapply of t * t
+ | Ldot of lid * string
+ | Lapply of lid * lid
+
+type t = {
+ lid : lid;
+ loc : Location.t
+}
val flatten: t -> string list
val last: t -> string
-val parse: string -> t
+val parse: Location.t -> string -> t
+
+val longident : Location.t -> lid -> t
+val lident : Location.t -> string -> t
View
91 parsing/parser.mly
@@ -49,7 +49,8 @@ let reloc_pat x = { x with ppat_loc = symbol_rloc () };;
let reloc_exp x = { x with pexp_loc = symbol_rloc () };;
let mkoperator name pos =
- { pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos }
+ let loc = rhs_loc pos in
+ { pexp_desc = Pexp_ident(lident loc name); pexp_loc = loc }
(*
Ghost expressions and patterns:
@@ -74,7 +75,7 @@ let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
let mkassert e =
match e with
- | {pexp_desc = Pexp_construct (Lident "false", None, false) } ->
+ | {pexp_desc = Pexp_construct ({lid = Lident "false"}, None, false) } ->
mkexp (Pexp_assertfalse)
| _ -> mkexp (Pexp_assert (e))
;;
@@ -113,35 +114,38 @@ let mkuplus name arg =
| _ ->
mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
+let ghlid lid = longident (symbol_gloc ())lid
+let ghlident name = ghlid (Lident name)
+
let rec mktailexp = function
[] ->
- ghexp(Pexp_construct(Lident "[]", None, false))
+ ghexp(Pexp_construct(ghlident "[]", None, false))
| e1 :: el ->
let exp_el = mktailexp el in
let l = {loc_start = e1.pexp_loc.loc_start;
loc_end = exp_el.pexp_loc.loc_end;
loc_ghost = true}
in
let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l} in
- {pexp_desc = Pexp_construct(Lident "::", Some arg, false); pexp_loc = l}
+ {pexp_desc = Pexp_construct(lident l "::", Some arg, false); pexp_loc = l}
let rec mktailpat = function
[] ->
- ghpat(Ppat_construct(Lident "[]", None, false))
+ ghpat(Ppat_construct(ghlident "[]", None, false))
| p1 :: pl ->
let pat_pl = mktailpat pl in
let l = {loc_start = p1.ppat_loc.loc_start;
loc_end = pat_pl.ppat_loc.loc_end;
loc_ghost = true}
in
let arg = {ppat_desc = Ppat_tuple [p1; pat_pl]; ppat_loc = l} in
- {ppat_desc = Ppat_construct(Lident "::", Some arg, false); ppat_loc = l}
+ {ppat_desc = Ppat_construct(lident l "::", Some arg, false); ppat_loc = l}
let ghstrexp e =
{ pstr_desc = Pstr_eval e; pstr_loc = {e.pexp_loc with loc_ghost = true} }
let array_function str name =
- Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))
+ ghlid (Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name)))
let rec deep_mkrangepat c1 c2 =
if c1 = c2 then ghpat(Ppat_constant(Const_char c1)) else
@@ -161,7 +165,7 @@ let unclosed opening_name opening_num closing_name closing_num =
rhs_loc closing_num, closing_name)))
let bigarray_function str name =
- Ldot(Ldot(Lident "Bigarray", str), name)
+ ghlid (Ldot(Ldot(Lident "Bigarray", str), name))
let bigarray_untuplify = function
{ pexp_desc = Pexp_tuple explist} -> explist
@@ -207,7 +211,7 @@ let lapply p1 p2 =
else raise (Syntaxerr.Error(Syntaxerr.Applicative_path (symbol_rloc())))
let exp_of_label lbl =
- mkexp (Pexp_ident(Lident(Longident.last lbl)))
+ mkexp (Pexp_ident(lident (lbl.loc) (Longident.last lbl)))
let pat_of_label lbl =
mkpat (Ppat_var(Longident.last lbl))
@@ -760,13 +764,13 @@ class_type:
| QUESTION LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
{ mkcty(Pcty_fun("?" ^ $2 ,
{ptyp_desc =
- Ptyp_constr(Ldot (Lident "*predef*", "option"), [$4]);
+ Ptyp_constr(ghlid (Ldot (Lident "*predef*", "option")), [$4]);
ptyp_loc = $4.ptyp_loc},
$6)) }
| OPTLABEL simple_core_type_or_tuple MINUSGREATER class_type
{ mkcty(Pcty_fun("?" ^ $1 ,
{ptyp_desc =
- Ptyp_constr(Ldot (Lident "*predef*", "option"), [$2]);
+ Ptyp_constr(ghlid (Ldot (Lident "*predef*", "option")), [$2]);
ptyp_loc = $2.ptyp_loc},
$4)) }
| LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
@@ -942,11 +946,11 @@ expr:
| FOR val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
{ mkexp(Pexp_for($2, $4, $6, $5, $8)) }
| expr COLONCOLON expr
- { mkexp(Pexp_construct(Lident "::",
+ { mkexp(Pexp_construct(lident (rhs_loc 2) "::",
Some(ghexp(Pexp_tuple[$1;$3])),
false)) }
| LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN
- { mkexp(Pexp_construct(Lident "::",
+ { mkexp(Pexp_construct(lident (rhs_loc 2) "::",
Some(ghexp(Pexp_tuple[$5;$7])),
false)) }
| expr INFIXOP0 expr
@@ -1026,7 +1030,7 @@ simple_expr:
| BEGIN seq_expr END
{ reloc_exp $2 }
| BEGIN END
- { mkexp (Pexp_construct (Lident "()", None, false)) }
+ { mkexp (Pexp_construct (lident (symbol_rloc ()) "()", None, false)) }
| BEGIN seq_expr error
{ unclosed "begin" 1 "end" 3 }
| LPAREN seq_expr type_constraint RPAREN
@@ -1110,7 +1114,7 @@ label_expr:
{ ("?" ^ $1, $2) }
;
label_ident:
- LIDENT { ($1, mkexp(Pexp_ident(Lident $1))) }
+ LIDENT { ($1, mkexp(Pexp_ident(lident (symbol_rloc ()) $1))) }
;
let_bindings:
let_binding { [$1] }
@@ -1205,10 +1209,10 @@ pattern:
| name_tag pattern %prec prec_constr_appl
{ mkpat(Ppat_variant($1, Some $2)) }
| pattern COLONCOLON pattern
- { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$1;$3])),
+ { mkpat(Ppat_construct(lident (rhs_loc 2) "::", Some(ghpat(Ppat_tuple[$1;$3])),
false)) }
| LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern RPAREN
- { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$5;$7])),
+ { mkpat(Ppat_construct(lident (rhs_loc 2) "::", Some(ghpat(Ppat_tuple[$5;$7])),
false)) }
| pattern BAR pattern
{ mkpat(Ppat_or($1, $3)) }
@@ -1428,11 +1432,11 @@ core_type2:
{ $1 }
| QUESTION LIDENT COLON core_type2 MINUSGREATER core_type2
{ mktyp(Ptyp_arrow("?" ^ $2 ,
- {ptyp_desc = Ptyp_constr(Ldot (Lident "*predef*", "option"), [$4]);
+ {ptyp_desc = Ptyp_constr(ghlid (Ldot (Lident "*predef*", "option")), [$4]);
ptyp_loc = $4.ptyp_loc}, $6)) }
| OPTLABEL core_type2 MINUSGREATER core_type2
{ mktyp(Ptyp_arrow("?" ^ $1 ,
- {ptyp_desc = Ptyp_constr(Ldot (Lident "*predef*", "option"), [$2]);
+ {ptyp_desc = Ptyp_constr(ghlid (Ldot (Lident "*predef*", "option")), [$2]);
ptyp_loc = $2.ptyp_loc}, $4)) }
| LIDENT COLON core_type2 MINUSGREATER core_type2
{ mktyp(Ptyp_arrow($1, $3, $5)) }
@@ -1621,47 +1625,58 @@ constr_ident:
| TRUE { "true" }
;
-val_longident:
+val_lid:
val_ident { Lident $1 }
- | mod_longident DOT val_ident { Ldot($1, $3) }
+ | mod_lid DOT val_ident { Ldot($1, $3) }
;
-constr_longident:
- mod_longident %prec below_DOT { $1 }
+constr_lid:
+ mod_lid %prec below_DOT { $1 }
| LBRACKET RBRACKET { Lident "[]" }
| LPAREN RPAREN { Lident "()" }
| FALSE { Lident "false" }
| TRUE { Lident "true" }
;
-label_longident:
+label_lid:
LIDENT { Lident $1 }
- | mod_longident DOT LIDENT { Ldot($1, $3) }
+ | mod_lid DOT LIDENT { Ldot($1, $3) }
;
-type_longident:
+type_lid:
LIDENT { Lident $1 }
- | mod_ext_longident DOT LIDENT { Ldot($1, $3) }
+ | mod_ext_lid DOT LIDENT { Ldot($1, $3) }
;
-mod_longident:
+mod_lid:
UIDENT { Lident $1 }
- | mod_longident DOT UIDENT { Ldot($1, $3) }
+ | mod_lid DOT UIDENT { Ldot($1, $3) }
;
-mod_ext_longident:
+mod_ext_lid:
UIDENT { Lident $1 }
- | mod_ext_longident DOT UIDENT { Ldot($1, $3) }
- | mod_ext_longident LPAREN mod_ext_longident RPAREN { lapply $1 $3 }
+ | mod_ext_lid DOT UIDENT { Ldot($1, $3) }
+ | mod_ext_lid LPAREN mod_ext_lid RPAREN { lapply $1 $3 }
;
-mty_longident:
+mty_lid:
ident { Lident $1 }
- | mod_ext_longident DOT ident { Ldot($1, $3) }
+ | mod_ext_lid DOT ident { Ldot($1, $3) }
;
-clty_longident:
+clty_lid:
LIDENT { Lident $1 }
- | mod_ext_longident DOT LIDENT { Ldot($1, $3) }
+ | mod_ext_lid DOT LIDENT { Ldot($1, $3) }
;
-class_longident:
+class_lid:
LIDENT { Lident $1 }
- | mod_longident DOT LIDENT { Ldot($1, $3) }
+ | mod_lid DOT LIDENT { Ldot($1, $3) }
;
+val_longident: val_lid { longident (symbol_rloc ()) $1 }
+constr_longident: constr_lid { longident (symbol_rloc ()) $1 }
+label_longident: label_lid { longident (symbol_rloc ()) $1 }
+type_longident: type_lid { longident (symbol_rloc ()) $1 }
+mod_longident: mod_lid { longident (symbol_rloc ()) $1 }
+mod_ext_longident: mod_ext_lid { longident (symbol_rloc ()) $1 }
+mty_longident: mty_lid { longident (symbol_rloc ()) $1 }
+clty_longident: clty_lid { longident (symbol_rloc ()) $1 }
+class_longident: class_lid { longident (symbol_rloc ()) $1 }
+
+
/* Toplevel directives */
toplevel_directive:
View
38 parsing/pprintast.ml
@@ -102,7 +102,7 @@ let fixity_of_string s =
|| (is_in_list (String.get s 0) infix_symbols)) then Infix else Prefix
let fixity_of_longident li =
- match li with
+ match li.Longident.lid with
| Longident.Lident name ->
fixity_of_string name
| Longident.Ldot (_, name)
@@ -140,7 +140,7 @@ let rec fmt_longident_aux f x =
fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z;
;;
-let fmt_longident ppf x = fprintf ppf "%a" fmt_longident_aux x;;
+let fmt_longident ppf x = fprintf ppf "%a" fmt_longident_aux x.Longident.lid;;
let fmt_char f c =
let i = int_of_char c in
@@ -287,9 +287,9 @@ let option_quiet f ppf x =
let rec expression_is_terminal_list exp =
match exp with
- | {pexp_desc = Pexp_construct (Longident.Lident("[]"), None, _)}
+ | {pexp_desc = Pexp_construct ({Longident.lid = Longident.Lident("[]")}, None, _)}
-> true ;
- | {pexp_desc = Pexp_construct (Longident.Lident("::"),
+ | {pexp_desc = Pexp_construct ({Longident.lid = Longident.Lident("::")},
Some({pexp_desc = Pexp_tuple([exp1 ; exp2])}), _)}
-> (expression_is_terminal_list exp2)
| {pexp_desc = _}
@@ -307,7 +307,7 @@ let rec core_type ppf x =
| "" -> core_type ppf ct1;
| s when (String.get s 0 = '?') ->
(match ct1.ptyp_desc with
- | Ptyp_constr (Longident.Lident ("option"), l) ->
+ | Ptyp_constr ({Longident.lid = Longident.Lident ("option")}, l) ->
fprintf ppf "%s :@ " s ;
type_constr_list ppf l ;
| _ -> core_type ppf ct1; (* todo: what do we do here? *)
@@ -446,7 +446,7 @@ and pattern ppf x =
match x.ppat_desc with
| Ppat_construct (li, po, b) ->
pp_open_hovbox ppf indent ;
- (match li,po with
+ (match li.Longident.lid,po with
| Longident.Lident("::"),
Some ({ppat_desc = Ppat_tuple([pat1; pat2])}) ->
fprintf ppf "(" ;
@@ -664,9 +664,10 @@ and expression ppf x =
let fixity = (is_infix (fixity_of_exp e)) in
let sd =
(match e.pexp_desc with
- | Pexp_ident (Longident.Ldot (Longident.Lident(modname), valname))
+ | Pexp_ident
+ {Longident.lid = Longident.Ldot (Longident.Lident(modname), valname)}
-> (modname, valname)
- | Pexp_ident (Longident.Lident(valname))
+ | Pexp_ident {Longident.lid = Longident.Lident(valname)}
-> ("",valname)
| _ -> ("",""))
in
@@ -763,7 +764,7 @@ and expression ppf x =
pp_close_box ppf ();
fprintf ppf ")";
| Pexp_construct (li, eo, b) ->
- (match li with
+ (match li.Longident.lid with
| Longident.Lident ("::") ->
(match eo with
Some ({pexp_desc = Pexp_tuple ([exp1 ; exp2])}) ->
@@ -1803,7 +1804,7 @@ and pattern_x_expression_def ppf (p, e) =
and pattern_list_helper ppf p =
match p with
- | {ppat_desc = Ppat_construct (Longident.Lident("::"),
+ | {ppat_desc = Ppat_construct ({Longident.lid = Longident.Lident("::")},
Some ({ppat_desc = Ppat_tuple([pat1; pat2])}),
_)}
-> pattern ppf pat1 ;
@@ -1838,13 +1839,14 @@ and label_x_expression_param ppf (l,e) =
and expression_in_parens ppf e =
let already_has_parens =
(match e.pexp_desc with
- Pexp_apply ({pexp_desc=Pexp_ident (Longident.Ldot (
- Longident.Lident(modname), funname))},_)
+ Pexp_apply ({pexp_desc=Pexp_ident {Longident.lid = Longident.Ldot (
+ Longident.Lident(modname), funname)}},_)
-> (match modname,funname with
| "Array","get" -> false;
| "Array","set" -> false;
| _,_ -> true) ;
- | Pexp_apply ({pexp_desc=Pexp_ident (Longident.Lident(funname))},_)
+ | Pexp_apply
+ ({pexp_desc=Pexp_ident {Longident.lid = Longident.Lident(funname)}},_)
-> (match funname with
| "!" -> false;
| _ -> true);
@@ -1988,9 +1990,10 @@ and expression_sequence ppf ?(skip=1) ?(indent=indent) ?(first=true) expr =
and expression_list_helper ppf exp =
match exp with
- | {pexp_desc = Pexp_construct (Longident.Lident("[]"), None, _)}
+ | {pexp_desc = Pexp_construct ({Longident.lid = Longident.Lident("[]")},
+ None, _)}
-> () ;
- | {pexp_desc = Pexp_construct (Longident.Lident("::"),
+ | {pexp_desc = Pexp_construct ({Longident.lid = Longident.Lident("::")},
Some({pexp_desc = Pexp_tuple([exp1 ; exp2])}), _)}
-> fprintf ppf ";@ " ;
simple_expr ppf exp1 ;
@@ -2000,9 +2003,10 @@ and expression_list_helper ppf exp =
and expression_list_nonterminal ppf exp =
match exp with
- | {pexp_desc = Pexp_construct (Longident.Lident("[]"), None, _)}
+ | {pexp_desc = Pexp_construct ({Longident.lid = Longident.Lident("[]")},
+ None, _)}
-> fprintf ppf "[]" ; (* assert false; *)
- | {pexp_desc = Pexp_construct (Longident.Lident("::"),
+ | {pexp_desc = Pexp_construct ({Longident.lid = Longident.Lident("::")},
Some({pexp_desc = Pexp_tuple([exp1 ; exp2])}), _)}
-> simple_expr ppf exp1;
fprintf ppf " ::@ ";
View
2 parsing/printast.ml
@@ -40,7 +40,7 @@ let rec fmt_longident_aux f x =
fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z;
;;
-let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x;;
+let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x.Longident.lid;;
let fmt_constant f x =
match x with
View
4 tools/depend.ml
@@ -32,10 +32,12 @@ let rec addmodule bv lid =
| Lapply(l1, l2) -> addmodule bv l1; addmodule bv l2
let add bv lid =
- match lid with
+ match lid.lid with
Ldot(l, s) -> addmodule bv l
| _ -> ()
+let addmodule bv l = addmodule bv l.lid
+
let rec add_type bv ty =
match ty.ptyp_desc with
Ptyp_any -> ()
View
4 toplevel/genprintval.ml
@@ -346,11 +346,11 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
and tree_of_exception depth bucket =
let name = (O.obj(O.field(O.field bucket 0) 0) : string) in
- let lid = Longident.parse name in
+ let lid = Longident.parse Location.none name in
try
(* Attempt to recover the constructor description for the exn
from its name *)
- let (_path, cstr) = Env.lookup_constructor lid env in
+ let (_path, cstr) = Env.lookup_constructor0 lid env in
let path =
match cstr.cstr_tag with
Cstr_exception p -> p | _ -> raise Not_found in
View
6 toplevel/topdirs.ml
@@ -157,7 +157,7 @@ let match_printer_type ppf desc typename =
let find_printer_type ppf lid =
try
- let (path, desc) = Env.lookup_value lid !toplevel_env in
+ let (path, desc) = Env.lookup_value0 lid !toplevel_env in
let (ty_arg, is_old_style) =
try
(match_printer_type ppf desc "printer_type_new", false)
@@ -210,7 +210,7 @@ let tracing_function_ptr =
let dir_trace ppf lid =
try
- let (path, desc) = Env.lookup_value lid !toplevel_env in
+ let (path, desc) = Env.lookup_value0 lid !toplevel_env in
(* Check if this is a primitive *)
match desc.val_kind with
| Val_prim p ->
@@ -246,7 +246,7 @@ let dir_trace ppf lid =
let dir_untrace ppf lid =
try
- let (path, desc) = Env.lookup_value lid !toplevel_env in
+ let (path, desc) = Env.lookup_value0 lid !toplevel_env in
let rec remove = function
| [] ->
fprintf ppf "%a was not traced.@." Printtyp.longident lid;
View
10 toplevel/trace.ml
@@ -62,10 +62,12 @@ let rec instrument_result env name ppf clos_typ =
match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
| Tarrow(l, t1, t2, _) ->
let starred_name =
- match name with
- | Lident s -> Lident(s ^ "*")
- | Ldot(lid, s) -> Ldot(lid, s ^ "*")
- | Lapply(l1, l2) -> fatal_error "Trace.instrument_result" in
+ {name with lid =
+ match name.lid with
+ | Lident s -> Lident(s ^ "*")
+ | Ldot(lid, s) -> Ldot(lid, s ^ "*")
+ | Lapply(l1, l2) -> fatal_error "Trace.instrument_result"
+ } in
let trace_res = instrument_result env starred_name ppf t2 in
(fun clos_val ->
Obj.repr (fun arg ->
View
5 typing/ctype.ml
@@ -2771,8 +2771,11 @@ let rec lid_of_path ?(sharp="") = function
| Path.Papply (p1, p2) ->
Longident.Lapply (lid_of_path ~sharp p1, lid_of_path p2)
+let lid_of_path ?sharp path =
+ {Longident.loc = Location.none ; lid = lid_of_path ?sharp path}
+
let find_cltype_for_path env p =
- let path, cl_abbr = Env.lookup_type (lid_of_path ~sharp:"#" p) env in
+ let path, cl_abbr = Env.lookup_type0 (lid_of_path ~sharp:"#" p) env in
match cl_abbr.type_manifest with
Some ty ->
begin match (repr ty).desc with
View
21 typing/env.ml
@@ -459,6 +459,8 @@ and lookup_module lid env =
raise Not_found
end
+let lookup_module lid = lookup_module lid.lid
+
let lookup proj1 proj2 lid env =
match lid with
Lident s ->
@@ -476,7 +478,7 @@ let lookup proj1 proj2 lid env =
raise Not_found
let lookup_simple proj1 proj2 lid env =
- match lid with
+ match lid.lid with
Lident s ->
Ident.find_name s (proj1 env)
| Ldot(l, s) ->
@@ -491,22 +493,29 @@ let lookup_simple proj1 proj2 lid env =
| Lapply(l1, l2) ->
raise Not_found
+let lookup0 proj1 proj2 lid = lookup proj1 proj2 lid.lid
+
let lookup_value =
lookup (fun env -> env.values) (fun sc -> sc.comp_values)
let lookup_annot id e =
- lookup (fun env -> env.annotations) (fun sc -> sc.comp_annotations) id e
+ lookup0 (fun env -> env.annotations) (fun sc -> sc.comp_annotations) id e
and lookup_constructor =
lookup (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
and lookup_label =
lookup (fun env -> env.labels) (fun sc -> sc.comp_labels)
and lookup_type =
lookup (fun env -> env.types) (fun sc -> sc.comp_types)
and lookup_modtype =
- lookup (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
+ lookup0 (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
and lookup_class =
- lookup (fun env -> env.classes) (fun sc -> sc.comp_classes)
+ lookup0 (fun env -> env.classes) (fun sc -> sc.comp_classes)
and lookup_cltype =
- lookup (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+ lookup0 (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+
+let lookup_value0 lid = lookup_value lid.lid
+let lookup_constructor0 lid = lookup_constructor lid.lid
+let lookup_label0 lid = lookup_label lid.lid
+let lookup_type0 lid = lookup_type lid.lid
let ident_tbl_fold f t acc =
List.fold_right
@@ -521,7 +530,7 @@ let find_all proj1 proj2 f lid env =
(fun id (p, data) -> f (Ident.name id) p data)
(proj1 env)
| Some l ->
- let p, desc = lookup_module_descr l env in
+ let p, desc = lookup_module_descr l.lid env in
begin match Lazy.force desc with
Structure_comps c ->
Tbl.fold
View
13 typing/env.mli
@@ -40,11 +40,16 @@ val find_modtype_expansion: Path.t -> t -> Types.module_type
(* Lookup by long identifiers *)
-val lookup_value: Longident.t -> t -> Path.t * value_description
+val lookup_value0: Longident.t -> t -> Path.t * value_description
+val lookup_label0: Longident.t -> t -> Path.t * label_description
+val lookup_type0: Longident.t -> t -> Path.t * type_declaration
+val lookup_constructor0: Longident.t -> t -> Path.t * constructor_description
+
+val lookup_value: Longident.lid -> t -> Path.t * value_description
val lookup_annot: Longident.t -> t -> Path.t * Annot.ident
-val lookup_constructor: Longident.t -> t -> Path.t * constructor_description
-val lookup_label: Longident.t -> t -> Path.t * label_description
-val lookup_type: Longident.t -> t -> Path.t * type_declaration
+val lookup_constructor: Longident.lid -> t -> Path.t * constructor_description
+val lookup_label: Longident.lid -> t -> Path.t * label_description
+val lookup_type: Longident.lid -> t -> Path.t * type_declaration
val lookup_module: Longident.t -> t -> Path.t * module_type
val lookup_modtype: Longident.t -> t -> Path.t * modtype_declaration
val lookup_class: Longident.t -> t -> Path.t * class_declaration
View
2 typing/printtyp.ml
@@ -31,6 +31,8 @@ let rec longident ppf = function
| Ldot(p, s) -> fprintf ppf "%a.%s" longident p s
| Lapply(p1, p2) -> fprintf ppf "%a(%a)" longident p1 longident p2
+let longident ppf lid = longident ppf lid.lid
+
(* Print an identifier *)
let unique_names = ref Ident.empty
View
14 typing/typeclass.ml
@@ -649,7 +649,7 @@ let rec class_field cl_num self_type meths vars
(fun id (vals, met_env, par_env) ->
let expr =
Typecore.type_exp val_env
- {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
+ {pexp_desc = Pexp_ident (Longident.lident Location.none (Ident.name id));
pexp_loc = Location.none}
in
let desc =
@@ -843,18 +843,18 @@ and class_expr cl_num val_env met_env scl =
let loc = default.pexp_loc in
let scases =
[{ppat_loc = loc; ppat_desc =
- Ppat_construct(Longident.(Ldot (Lident"*predef*", "Some")),
+ Ppat_construct(Longident.longident loc (Longident.Ldot (Longident.Lident"*predef*", "Some")),
Some{ppat_loc = loc; ppat_desc = Ppat_var"*sth*"},
false)},
- {pexp_loc = loc; pexp_desc = Pexp_ident(Longident.Lident"*sth*")};
+ {pexp_loc = loc; pexp_desc = Pexp_ident(Longident.lident loc "*sth*")};
{ppat_loc = loc; ppat_desc =
- Ppat_construct(Longident.(Ldot (Lident"*predef*", "None")),
+ Ppat_construct(Longident.longident loc (Longident.Ldot (Longident.Lident"*predef*", "None")),
None, false)},
default] in
let smatch =
{pexp_loc = loc; pexp_desc =
Pexp_match({pexp_loc = loc; pexp_desc =
- Pexp_ident(Longident.Lident"*opt*")},
+ Pexp_ident(Longident.lident loc "*opt*")},
scases)} in
let sfun =
{pcl_loc = scl.pcl_loc; pcl_desc =
@@ -877,7 +877,7 @@ and class_expr cl_num val_env met_env scl =
(function (id, id', ty) ->
(id,
Typecore.type_exp val_env'
- {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
+ {pexp_desc = Pexp_ident (Longident.lident Location.none (Ident.name id));
pexp_loc = Location.none}))
pv
in
@@ -1003,7 +1003,7 @@ and class_expr cl_num val_env met_env scl =
Ctype.begin_def ();
let expr =
Typecore.type_exp val_env
- {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
+ {pexp_desc = Pexp_ident (Longident.lident Location.none (Ident.name id));
pexp_loc = Location.none}
in
Ctype.end_def ();
View
35 typing/typecore.ml
@@ -119,14 +119,14 @@ let type_option ty =
newty (Tconstr(Predef.path_option,[ty], ref Mnil))
let option_none ty loc =
- let lid = Longident.Lident "None" in
- let (path, cnone) = Env.lookup_constructor lid Env.initial in
+ let lid = Longident.lident Location.none "None" in
+ let (path, cnone) = Env.lookup_constructor0 lid Env.initial in
{ exp_desc = Texp_construct(path, cnone, []);
exp_type = ty; exp_loc = loc; exp_env = Env.initial }
let option_some texp =
- let lid = Longident.Lident "Some" in
- let (path, csome) = Env.lookup_constructor lid Env.initial in
+ let lid = Longident.lident Location.none "Some" in
+ let (path, csome) = Env.lookup_constructor0 lid Env.initial in
{ exp_desc = Texp_construct(path, csome, [texp]); exp_loc = texp.exp_loc;
exp_type = type_option texp.exp_type; exp_env = texp.exp_env }
@@ -369,18 +369,20 @@ let build_or_pat env loc lid =
let rec find_record_qual = function
| [] -> None
- | (Longident.Ldot (modname, _), _) :: _ -> Some modname
+ | ({Longident.lid = Longident.Ldot (modname, _)}, _) :: _ -> Some modname
| _ :: rest -> find_record_qual rest
let type_label_a_list type_lid_a lid_a_list =
match find_record_qual lid_a_list with
| None -> List.map type_lid_a lid_a_list
| Some modname ->
List.map
- (function
- | (Longident.Lident id), sarg ->
- type_lid_a (Longident.Ldot (modname, id), sarg)
- | lid_a -> type_lid_a lid_a)
+ (function lid, sarg as lid_a ->
+ match lid.Longident.lid with
+ | Longident.Lident id ->
+ type_lid_a
+ ({lid with Longident.lid = Longident.Ldot (modname, id)}, sarg)
+ | _ -> type_lid_a lid_a)
lid_a_list
(* Checks over the labels mentioned in a record pattern:
@@ -395,7 +397,7 @@ let check_recordpat_labels loc lbl_pat_list closed =
let check_defined (_, label, _) =
if defined.(label.lbl_pos)
then raise(Error(loc, Label_multiply_defined
- (Longident.Lident label.lbl_name)))
+ (Longident.lident Location.none label.lbl_name)))
else defined.(label.lbl_pos) <- true in
List.iter check_defined lbl_pat_list;
if closed = Closed
@@ -958,7 +960,7 @@ let rec approx_type env sty =
newty (Ttuple (List.map (approx_type env) args))
| Ptyp_constr (lid, ctl) ->
begin try
- let (path, decl) = Env.lookup_type lid env in
+ let (path, decl) = Env.lookup_type0 lid env in
if List.length ctl <> decl.type_arity then raise Not_found;
let tyl = List.map (approx_type env) ctl in
newconstr path tyl
@@ -1072,7 +1074,7 @@ let wrap_unpacks sexp unpacks =
{pexp_loc = sexp.pexp_loc; pexp_desc = Pexp_letmodule (
name,
{pmod_loc = loc; pmod_desc = Pmod_unpack
- {pexp_desc=Pexp_ident(Longident.Lident name); pexp_loc=loc}},
+ {pexp_desc=Pexp_ident(Longident.lident loc name); pexp_loc=loc}},
sexp)})
sexp unpacks
@@ -2127,22 +2129,23 @@ function ~l:*opt* ->
{ppat_loc = default_loc;
ppat_desc =
Ppat_construct
- (Longident.(Ldot (Lident "*predef*", "Some")),
+ (Longident.longident default_loc (Longident.Ldot (Longident.Lident "*predef*", "Some")),
Some {ppat_loc = default_loc; ppat_desc = Ppat_var "*sth*"},
false)},
{pexp_loc = default_loc;
- pexp_desc = Pexp_ident(Longident.Lident "*sth*")};
+ pexp_desc = Pexp_ident(Longident.lident default_loc "*sth*")};
{ppat_loc = default_loc;
ppat_desc = Ppat_construct
- (Longident.(Ldot (Lident "*predef*", "None")), None, false)},
+ (Longident.longident default_loc (Longident.Ldot (Longident.Lident "*predef*", "None")),
+ None, false)},
default;
] in
let smatch = {
pexp_loc = loc;
pexp_desc =
Pexp_match ({
pexp_loc = loc;
- pexp_desc = Pexp_ident(Longident.Lident "*opt*")
+ pexp_desc = Pexp_ident(Longident.lident loc "*opt*")
},
scases
)
View
2 typing/typedecl.ml
@@ -776,7 +776,7 @@ let transl_exception env excdecl =
let transl_exn_rebind env loc lid =
let (path, cdescr) =
try
- Env.lookup_constructor lid env
+ Env.lookup_constructor0 lid env
with Not_found ->
raise(Error(loc, Unbound_exception lid)) in
match cdescr.cstr_tag with
View
2 typing/typemod.ml
@@ -198,7 +198,7 @@ let merge_constraint initial_env loc sg lid constr =
with Exit -> raise (Error (sdecl.ptype_loc, With_need_typeconstr))
in
let (path, _) =
- try Env.lookup_type lid initial_env with Not_found -> assert false
+ try Env.lookup_type0 lid initial_env with Not_found -> assert false
in
let sub = Subst.add_type id path Subst.identity in
Subst.signature sub sg
View
37 typing/typetexp.ml
@@ -58,10 +58,11 @@ type variable_context = int * (string, type_expr) Tbl.t
let rec narrow_unbound_lid_error env loc lid make_error =
let check_module mlid =
+ let mlid = Longident.longident lid.Longident.loc mlid in
try ignore (Env.lookup_module mlid env)
with Not_found -> narrow_unbound_lid_error env loc mlid (fun lid -> Unbound_module lid); assert false
in
- begin match lid with
+ begin match lid.Longident.lid with
| Longident.Lident _ -> ()
| Longident.Ldot (mlid, _) -> check_module mlid
| Longident.Lapply (flid, mlid) ->
@@ -73,23 +74,24 @@ let rec narrow_unbound_lid_error env loc lid make_error =
let find_component lookup make_error env loc lid =
try
- match lid with
- | Longident.Ldot (Longident.Lident "*predef*", s) -> lookup (Longident.Lident s) Env.initial
+ match lid.Longident.lid with
+ | Longident.Ldot (Longident.Lident "*predef*", s) ->
+ lookup (Longident.lident lid.Longident.loc s) Env.initial
| _ -> lookup lid env
with Not_found ->
(narrow_unbound_lid_error env loc lid make_error
: unit (* to avoid a warning *));
assert false
-let find_type = find_component Env.lookup_type (fun lid -> Unbound_type_constructor lid)
+let find_type = find_component Env.lookup_type0 (fun lid -> Unbound_type_constructor lid)
-let find_constructor = find_component Env.lookup_constructor (fun lid -> Unbound_constructor lid)
+let find_constructor = find_component Env.lookup_constructor0 (fun lid -> Unbound_constructor lid)
-let find_label = find_component Env.lookup_label (fun lid -> Unbound_label lid)
+let find_label = find_component Env.lookup_label0 (fun lid -> Unbound_label lid)
let find_class = find_component Env.lookup_class (fun lid -> Unbound_class lid)
-let find_value = find_component Env.lookup_value (fun lid -> Unbound_value lid)
+let find_value = find_component Env.lookup_value0 (fun lid -> Unbound_value lid)
let find_module = find_component Env.lookup_module (fun lid -> Unbound_module lid)
@@ -120,7 +122,9 @@ let create_package_mty fake loc env (p, l) =
ptype_manifest = if fake then None else Some t;
ptype_variance = [];
ptype_loc = loc} in
- {pmty_desc=Pmty_with (mty, [ Longident.Lident s, Pwith_type d ]); pmty_loc=loc}
+ {pmty_desc=
+ Pmty_with
+ (mty, [ Longident.lident Location.none s, Pwith_type d ]); pmty_loc=loc}
)
{pmty_desc=Pmty_ident p; pmty_loc=loc}
l
@@ -254,7 +258,7 @@ let rec transl_type env policy styp =
| Ptyp_class(lid, stl, present) ->
let (path, decl, is_variant) =
try
- let (path, decl) = Env.lookup_type lid env in
+ let (path, decl) = Env.lookup_type0 lid env in
let rec check decl =
match decl.type_manifest with
None -> raise Not_found
@@ -269,13 +273,14 @@ let rec transl_type env policy styp =
(path, decl,true)
with Not_found -> try
if present <> [] then raise Not_found;
- let lid2 =
- match lid with
- Longident.Lident s -> Longident.Lident ("#" ^ s)
- | Longident.Ldot(r, s) -> Longident.Ldot (r, "#" ^ s)
- | Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
- in
- let (path, decl) = Env.lookup_type lid2 env in
+ let lid2 = {
+ lid with Longident.lid =
+ match lid.Longident.lid with
+ Longident.Lident s -> Longident.Lident ("#" ^ s)
+ | Longident.Ldot(r, s) -> Longident.Ldot (r, "#" ^ s)
+ | Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
+ } in
+ let (path, decl) = Env.lookup_type0 lid2 env in
(path, decl, false)
with Not_found ->
raise(Error(styp.ptyp_loc, Unbound_class lid))
View
3 typing/untypeast.ml
@@ -42,6 +42,9 @@ let rec lident_of_path path =
| Path.Papply (p1, p2) ->
Longident.Lapply (lident_of_path p1, lident_of_path p2)
+let lident_of_path path =
+ Longident.longident Location.none (lident_of_path path)
+
let rec untype_structure str =
List.map untype_structure_item str.str_items
View
2 typing/unused_var.ml
@@ -110,7 +110,7 @@ and structure_item ppf tbl s =
and expression ppf tbl e =
match e.pexp_desc with
- | Pexp_ident (Longident.Lident id) ->
+ | Pexp_ident {Longident.lid = Longident.Lident id} ->
begin try (Hashtbl.find tbl id) := true;
with Not_found -> ()
end;

0 comments on commit 6283226

Please sign in to comment.