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

compilerlibs: expose parsers for 'Longident.t's

master
Florian Angeletti 2020-01-06 14:24:26 +01:00
parent e667d9fb8d
commit 40e40a9c20
17 changed files with 6228 additions and 5241 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
.depend
View File

@ -346,7 +346,8 @@ parsing/parse.cmx : \
parsing/docstrings.cmx \
parsing/parse.cmi
parsing/parse.cmi : \
parsing/parsetree.cmi
parsing/parsetree.cmi \
parsing/longident.cmi
parsing/parser.cmo : \
parsing/syntaxerr.cmi \
parsing/parsetree.cmi \
@ -371,6 +372,7 @@ parsing/parser.cmx : \
parsing/parser.cmi
parsing/parser.cmi : \
parsing/parsetree.cmi \
parsing/longident.cmi \
parsing/location.cmi \
parsing/docstrings.cmi \
parsing/camlinternalMenhirLib.cmi
@ -1407,6 +1409,7 @@ typing/typemod.cmo : \
typing/printtyp.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
parsing/parse.cmi \
typing/mtype.cmi \
utils/misc.cmi \
parsing/longident.cmi \
@ -1439,6 +1442,7 @@ typing/typemod.cmx : \
typing/printtyp.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
parsing/parse.cmx \
typing/mtype.cmx \
utils/misc.cmx \
parsing/longident.cmx \
@ -5787,7 +5791,6 @@ driver/makedepend.cmo : \
parsing/parser.cmi \
parsing/parse.cmi \
utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
parsing/lexer.cmi \
parsing/depend.cmi \
@ -5801,7 +5804,6 @@ driver/makedepend.cmx : \
parsing/parser.cmx \
parsing/parse.cmx \
utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
parsing/lexer.cmx \
parsing/depend.cmx \
@ -5934,9 +5936,11 @@ toplevel/expunge.cmx : \
bytecomp/bytesections.cmx
toplevel/genprintval.cmo : \
typing/types.cmi \
parsing/syntaxerr.cmi \
typing/printtyp.cmi \
typing/predef.cmi \
typing/path.cmi \
parsing/parse.cmi \
typing/outcometree.cmi \
typing/oprint.cmi \
utils/misc.cmi \
@ -5949,9 +5953,11 @@ toplevel/genprintval.cmo : \
toplevel/genprintval.cmi
toplevel/genprintval.cmx : \
typing/types.cmx \
parsing/syntaxerr.cmx \
typing/printtyp.cmx \
typing/predef.cmx \
typing/path.cmx \
parsing/parse.cmx \
typing/outcometree.cmi \
typing/oprint.cmx \
utils/misc.cmx \

3
Changes
View File

@ -111,6 +111,9 @@ Working version
- #9060: ensure that Misc.protect_refs preserves backtraces
(Gabriel Scherer, review by Guillaume Munch-Maccagnoni and David Allsopp)
- #9061: expose compiler Longident.t parsers
(Florian Angeletti, review by Gabriel Scherer)
- #9078: make all compilerlibs/ available to ocamltest.
(Gabriel Scherer, review by Sébastien Hinderer)

11042
boot/menhir/parser.ml
View File

File diff suppressed because one or more lines are too long

24
boot/menhir/parser.mli
View File

@ -136,12 +136,24 @@ val use_file: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.toplevel_p
val toplevel_phrase: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.toplevel_phrase)
val parse_val_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
val parse_pattern: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.pattern)
val parse_mty_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
val parse_mod_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
val parse_mod_ext_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
val parse_expression: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.expression)
val parse_core_type: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.core_type)
val parse_constr_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
val parse_any_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
val interface: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.signature)
val implementation: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.structure)
@ -163,12 +175,24 @@ module Incremental : sig
val toplevel_phrase: Lexing.position -> (Parsetree.toplevel_phrase) MenhirInterpreter.checkpoint
val parse_val_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
val parse_pattern: Lexing.position -> (Parsetree.pattern) MenhirInterpreter.checkpoint
val parse_mty_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
val parse_mod_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
val parse_mod_ext_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
val parse_expression: Lexing.position -> (Parsetree.expression) MenhirInterpreter.checkpoint
val parse_core_type: Lexing.position -> (Parsetree.core_type) MenhirInterpreter.checkpoint
val parse_constr_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
val parse_any_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
val interface: Lexing.position -> (Parsetree.signature) MenhirInterpreter.checkpoint
val implementation: Lexing.position -> (Parsetree.structure) MenhirInterpreter.checkpoint

3
debugger/Makefile
View File

@ -45,7 +45,8 @@ utils_modules := $(addprefix utils/,\
parsing_modules := $(addprefix parsing/,\
location longident docstrings syntaxerr ast_helper ast_mapper ast_iterator \
attr_helper builtin_attributes pprintast)
attr_helper builtin_attributes pprintast \
lexer camlinternalMenhirLib parser parse)
typing_modules := $(addprefix typing/,\
ident path type_immediacy types btype primitive typedtree subst predef \

7
driver/makedepend.ml
View File

@ -310,7 +310,12 @@ let read_parse_and_extract parse_function extract_function def ast_kind
let bound_vars =
List.fold_left
(fun bv modname ->
Depend.open_module bv (Longident.parse modname))
let lid =
let lexbuf = Lexing.from_string modname in
Location.init lexbuf
(Printf.sprintf "command line argument: -open %S" modname);
Parse.simple_module_path lexbuf in
Depend.open_module bv lid)
!module_map ((* PR#7248 *) List.rev !Clflags.open_modules)
in
let r = extract_function bound_vars ast in

1
parsing/longident.ml
View File

@ -30,6 +30,7 @@ let last = function
| Ldot(_, s) -> s
| Lapply(_, _) -> Misc.fatal_error "Longident.last"
let rec split_at_dots s pos =
try
let dot = String.index_from s pos '.' in

26
parsing/longident.mli
View File

@ -27,8 +27,34 @@ type t =
val flatten: t -> string list
val unflatten: string list -> t option
(** For a non-empty list [l], [unflatten l] is [Some lid] where [lid] is
the long identifier created by concatenating the elements of [l]
with [Ldot].
[unflatten []] is [None].
*)
val last: t -> string
val parse: string -> t
[@@deprecated "this function may misparse its input,\n\
use \"Parse.longident\" or \"Longident.unflatten\""]
(**
This function is broken on identifiers that are not just "Word.Word.word";
for example, it returns incorrect results on infix operators
and extended module paths.
If you want to generate long identifiers that are a list of
dot-separated identifiers, the function {!unflatten} is safer and faster.
{!unflatten} is available since OCaml 4.06.0.
If you want to parse any identifier correctly, use the long-identifiers
functions from the {!Parse} module, in particular {!Parse.longident}.
They are available since OCaml 4.11, and also provide proper
input-location support.
*)
(** To print a longident, see {!Pprintast.longident}, using
{!Format.asprintf} to convert to a string. *)

8
parsing/parse.ml
View File

@ -121,7 +121,13 @@ and core_type = wrap_menhir Parser.Incremental.parse_core_type
and expression = wrap_menhir Parser.Incremental.parse_expression
and pattern = wrap_menhir Parser.Incremental.parse_pattern
let longident = wrap_menhir Parser.Incremental.parse_any_longident
let val_ident = wrap_menhir Parser.Incremental.parse_val_longident
let constr_ident= wrap_menhir Parser.Incremental.parse_constr_longident
let extended_module_path =
wrap_menhir Parser.Incremental.parse_mod_ext_longident
let simple_module_path = wrap_menhir Parser.Incremental.parse_mod_longident
let type_ident = wrap_menhir Parser.Incremental.parse_mty_longident
(* Error reporting for Syntaxerr *)
(* The code has been moved here so that one can reuse Pprintast.tyvar *)

79
parsing/parse.mli
View File

@ -27,3 +27,82 @@ val use_file : Lexing.lexbuf -> Parsetree.toplevel_phrase list
val core_type : Lexing.lexbuf -> Parsetree.core_type
val expression : Lexing.lexbuf -> Parsetree.expression
val pattern : Lexing.lexbuf -> Parsetree.pattern
(** The functions below can be used to parse Longident safely. *)
val longident: Lexing.lexbuf -> Longident.t
(**
The function [longident] is guaranted to parse all subclasses
of {!Longident.t} used in OCaml: values, constructors, simple or extended
module paths, and types or module types.
However, this function accepts inputs which are not accepted by the
compiler, because they combine functor applications and infix operators.
In valid OCaml syntax, only value-level identifiers may end with infix
operators [Foo.( + )].
Moreover, in value-level identifiers the module path [Foo] must be simple
([M.N] rather than [F(X)]): functor applications may only appear in
type-level identifiers.
As a consequence, a path such as [F(X).( + )] is not a valid OCaml
identifier; but it is accepted by this function.
*)
(** The next functions are specialized to a subclass of {!Longident.t} *)
val val_ident: Lexing.lexbuf -> Longident.t
(**
This function parses a syntactically valid path for a value. For instance,
[x], [M.x], and [(+.)] are valid. Contrarily, [M.A], [F(X).x], and [true]
are rejected.
Longident for OCaml's value cannot contain functor application.
The last component of the {!Longident.t} is not capitalized,
but can be an operator [A.Path.To.(.%.%.(;..)<-)]
*)
val constr_ident: Lexing.lexbuf -> Longident.t
(**
This function parses a syntactically valid path for a variant constructor.
For instance, [A], [M.A] and [M.(::)] are valid, but both [M.a]
and [F(X).A] are rejected.
Longident for OCaml's variant constructors cannot contain functor
application.
The last component of the {!Longident.t} is capitalized,
or it may be one the special constructors: [true],[false],[()],[[]],[(::)].
Among those special constructors, only [(::)] can be prefixed by a module
path ([A.B.C.(::)]).
*)
val simple_module_path: Lexing.lexbuf -> Longident.t
(**
This function parses a syntactically valid path for a module.
For instance, [A], and [M.A] are valid, but both [M.a]
and [F(X).A] are rejected.
Longident for OCaml's module cannot contain functor application.
The last component of the {!Longident.t} is capitalized.
*)
val extended_module_path: Lexing.lexbuf -> Longident.t
(**
This function parse syntactically valid path for an extended module.
For instance, [A.B] and [F(A).B] are valid. Contrarily,
[(.%())] or [[]] are both rejected.
The last component of the {!Longident.t} is capitalized.
*)
val type_ident: Lexing.lexbuf -> Longident.t
(**
This function parse syntactically valid path for a type or a module type.
For instance, [A], [t], [M.t] and [F(X).t] are valid. Contrarily,
[(.%())] or [[]] are both rejected.
In path for type and module types, only operators and special constructors
are rejected.
*)

113
parsing/parser.mly
View File

@ -787,6 +787,18 @@ The precedences must be listed from low to high.
%type <Parsetree.expression> parse_expression
%start parse_pattern
%type <Parsetree.pattern> parse_pattern
%start parse_constr_longident
%type <Longident.t> parse_constr_longident
%start parse_val_longident
%type <Longident.t> parse_val_longident
%start parse_mty_longident
%type <Longident.t> parse_mty_longident
%start parse_mod_ext_longident
%type <Longident.t> parse_mod_ext_longident
%start parse_mod_longident
%type <Longident.t> parse_mod_longident
%start parse_any_longident
%type <Longident.t> parse_any_longident
%%
/* macros */
@ -1128,6 +1140,35 @@ parse_pattern:
{ $1 }
;
parse_mty_longident:
mty_longident EOF
{ $1 }
;
parse_val_longident:
val_longident EOF
{ $1 }
;
parse_constr_longident:
constr_longident EOF
{ $1 }
;
parse_mod_ext_longident:
mod_ext_longident EOF
{ $1 }
;
parse_mod_longident:
mod_longident EOF
{ $1 }
;
parse_any_longident:
any_longident EOF
{ $1 }
;
(* -------------------------------------------------------------------------- *)
(* Functor arguments appear in module expressions and module types. *)
@ -3374,13 +3415,16 @@ ident:
UIDENT { $1 }
| LIDENT { $1 }
;
val_ident:
LIDENT { $1 }
val_extra_ident:
| LPAREN operator RPAREN { $2 }
| LPAREN operator error { unclosed "(" $loc($1) ")" $loc($3) }
| LPAREN error { expecting $loc($2) "operator" }
| LPAREN MODULE error { expecting $loc($3) "module-expr" }
;
val_ident:
LIDENT { $1 }
| val_extra_ident { $1 }
;
operator:
PREFIXOP { $1 }
| LETOP { $1 }
@ -3421,59 +3465,68 @@ index_mod:
| { "" }
| SEMI DOTDOT { ";.." }
;
constr_ident:
UIDENT { $1 }
%inline constr_extra_ident:
| LPAREN COLONCOLON RPAREN { "::" }
;
constr_extra_nonprefix_ident:
| LBRACKET RBRACKET { "[]" }
| LPAREN RPAREN { "()" }
| LPAREN COLONCOLON RPAREN { "::" }
| FALSE { "false" }
| TRUE { "true" }
;
val_longident:
val_ident { Lident $1 }
| mod_longident DOT val_ident { Ldot($1, $3) }
constr_ident:
UIDENT { $1 }
| constr_extra_ident { $1 }
| constr_extra_nonprefix_ident { $1 }
;
constr_longident:
mod_longident %prec below_DOT { $1 }
| mod_longident DOT LPAREN COLONCOLON RPAREN { Ldot($1,"::") }
| LBRACKET RBRACKET { Lident "[]" }
| LPAREN RPAREN { Lident "()" }
| LPAREN COLONCOLON RPAREN { Lident "::" }
| FALSE { Lident "false" }
| TRUE { Lident "true" }
mod_longident %prec below_DOT { $1 } /* A.B.x vs (A).B.x */
| mod_longident DOT constr_extra_ident { Ldot($1,$3) }
| constr_extra_ident { Lident $1 }
| constr_extra_nonprefix_ident { Lident $1 }
;
mk_longident(prefix,final):
| final { Lident $1 }
| prefix DOT final { Ldot($1,$3) }
;
val_longident:
mk_longident(mod_longident, val_ident) { $1 }
;
label_longident:
LIDENT { Lident $1 }
| mod_longident DOT LIDENT { Ldot($1, $3) }
mk_longident(mod_longident, LIDENT) { $1 }
;
type_longident:
LIDENT { Lident $1 }
| mod_ext_longident DOT LIDENT { Ldot($1, $3) }
mk_longident(mod_ext_longident, LIDENT) { $1 }
;
mod_longident:
UIDENT { Lident $1 }
| mod_longident DOT UIDENT { Ldot($1, $3) }
mk_longident(mod_longident, UIDENT) { $1 }
;
mod_ext_longident:
UIDENT { Lident $1 }
| mod_ext_longident DOT UIDENT { Ldot($1, $3) }
mk_longident(mod_ext_longident, UIDENT) { $1 }
| mod_ext_longident LPAREN mod_ext_longident RPAREN
{ lapply ~loc:$sloc $1 $3 }
| mod_ext_longident LPAREN error
{ expecting $loc($3) "module path" }
;
mty_longident:
ident { Lident $1 }
| mod_ext_longident DOT ident { Ldot($1, $3) }
mk_longident(mod_ext_longident,ident) { $1 }
;
clty_longident:
LIDENT { Lident $1 }
| mod_ext_longident DOT LIDENT { Ldot($1, $3) }
mk_longident(mod_ext_longident,LIDENT) { $1 }
;
class_longident:
LIDENT { Lident $1 }
| mod_longident DOT LIDENT { Ldot($1, $3) }
mk_longident(mod_longident,LIDENT) { $1 }
;
/* For compiler-libs: parse all valid longidents and a little more:
final identifiers which are value specific are accepted even when
the path prefix is only valid for types: (e.g. F(X).(::)) */
any_longident:
| mk_longident (mod_ext_longident,
ident | constr_extra_ident | val_extra_ident { $1 }
) { $1 }
| constr_extra_nonprefix_ident { Lident $1 }
;
/* Toplevel directives */

113
testsuite/tests/compiler-libs/test_longident.ml
View File

@ -3,8 +3,10 @@
include ocamlcommon
* expect
*)
[@@@alert "-deprecated"]
module L = Longident
[%%expect {|
module L = Longident
|}]
@ -56,32 +58,113 @@ let last_dot_apply = L.last
val last_dot_apply : string = "foo"
|}];;
type parse_result = { flat: L.t; spec:L.t; any_is_correct:bool }
let test specialized s =
let spec = specialized (Lexing.from_string s) in
{ flat = L.parse s;
spec;
any_is_correct = Parse.longident (Lexing.from_string s) = spec;
}
let parse_empty = L.parse ""
let parse_empty_val = Parse.longident (Lexing.from_string "")
[%%expect {|
type parse_result = { flat : L.t; spec : L.t; any_is_correct : bool; }
val test : (Lexing.lexbuf -> L.t) -> string -> parse_result = <fun>
val parse_empty : L.t = L.Lident ""
Exception:
Syntaxerr.Error
(Syntaxerr.Other
{Location.loc_start =
{Lexing.pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 0};
loc_end =
{Lexing.pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 0};
loc_ghost = false}).
|}]
let parse_ident = L.parse "foo"
let parse_ident = test Parse.val_ident "foo"
[%%expect {|
val parse_ident : L.t = L.Lident "foo"
val parse_ident : parse_result =
{flat = L.Lident "foo"; spec = L.Lident "foo"; any_is_correct = true}
|}]
let parse_dot = L.parse "M.foo"
let parse_dot = test Parse.val_ident "M.foo"
[%%expect {|
val parse_dot : L.t = L.Ldot (L.Lident "M", "foo")
val parse_dot : parse_result =
{flat = L.Ldot (L.Lident "M", "foo"); spec = L.Ldot (L.Lident "M", "foo");
any_is_correct = true}
|}]
let parse_path = L.parse "M.N.foo"
let parse_path = test Parse.val_ident "M.N.foo"
[%%expect {|
val parse_path : L.t = L.Ldot (L.Ldot (L.Lident "M", "N"), "foo")
val parse_path : parse_result =
{flat = L.Ldot (L.Ldot (L.Lident "M", "N"), "foo");
spec = L.Ldot (L.Ldot (L.Lident "M", "N"), "foo"); any_is_correct = true}
|}]
let parse_complex = L.parse "M.F(M.N).N.foo"
let parse_complex = test Parse.type_ident "M.F(M.N).N.foo"
(* the result below is a known misbehavior of Longident.parse
which does not handle applications properly. Fixing it
would be nice, but we soo no convenient way to do it without
introducing unpleasant dependencies. *)
which does not handle applications properly. *)
[%%expect {|
val parse_complex : L.t =
L.Ldot (L.Ldot (L.Ldot (L.Ldot (L.Lident "M", "F(M"), "N)"), "N"), "foo")
val parse_complex : parse_result =
{flat =
L.Ldot (L.Ldot (L.Ldot (L.Ldot (L.Lident "M", "F(M"), "N)"), "N"), "foo");
spec =
L.Ldot
(L.Ldot
(L.Lapply (L.Ldot (L.Lident "M", "F"), L.Ldot (L.Lident "M", "N")),
"N"),
"foo");
any_is_correct = true}
|}]
let parse_op = test Parse.val_ident "M.(.%.()<-)"
(* the result below is another known misbehavior of Longident.parse. *)
[%%expect {|
val parse_op : parse_result =
{flat = L.Ldot (L.Ldot (L.Ldot (L.Lident "M", "("), "%"), "()<-)");
spec = L.Ldot (L.Lident "M", ".%.()<-"); any_is_correct = true}
|}]
let parse_let_op = test Parse.val_ident "M.(let+*!)"
[%%expect {|
val parse_let_op : parse_result =
{flat = L.Ldot (L.Lident "M", "(let+*!)");
spec = L.Ldot (L.Lident "M", "let+*!"); any_is_correct = true}
|}]
let constr = test Parse.constr_ident "true"
[%%expect{|
val constr : parse_result =
{flat = L.Lident "true"; spec = L.Lident "true"; any_is_correct = true}
|}]
let prefix_constr = test Parse.constr_ident "A.B.C.(::)"
[%%expect{|
val prefix_constr : parse_result =
{flat = L.Ldot (L.Ldot (L.Ldot (L.Lident "A", "B"), "C"), "(::)");
spec = L.Ldot (L.Ldot (L.Ldot (L.Lident "A", "B"), "C"), "::");
any_is_correct = true}
|}]
let mod_ext = test Parse.extended_module_path "A.F(B.C(X)).G(Y).D"
[%%expect{|
val mod_ext : parse_result =
{flat =
L.Ldot (L.Ldot (L.Ldot (L.Ldot (L.Lident "A", "F(B"), "C(X))"), "G(Y)"),
"D");
spec =
L.Ldot
(L.Lapply
(L.Ldot
(L.Lapply (L.Ldot (L.Lident "A", "F"),
L.Lapply (L.Ldot (L.Lident "B", "C"), L.Lident "X")),
"G"),
L.Lident "Y"),
"D");
any_is_correct = true}
|}]
let string_of_longident lid = Format.asprintf "%a" Pprintast.longident lid
[%%expect{|
val string_of_longident : Longident.t -> string = <fun>
@ -90,15 +173,15 @@ let str_empty = string_of_longident parse_empty
[%%expect {|
val str_empty : string = ""
|}]
let str_ident = string_of_longident parse_ident
let str_ident = string_of_longident parse_ident.flat
[%%expect {|
val str_ident : string = "foo"
|}]
let str_dot = string_of_longident parse_dot
let str_dot = string_of_longident parse_dot.flat
[%%expect {|
val str_dot : string = "M.foo"
|}]
let str_path = string_of_longident parse_path
let str_path = string_of_longident parse_path.flat
[%%expect {|
val str_path : string = "M.N.foo"
|}]

4
testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference Normal file
View File

@ -0,0 +1,4 @@
File "tool-ocamlc-open-error.ml", line 1:
Warning 24: bad source file name: "Tool-ocamlc-open-error" is not a valid module name.
File "command line argument: -open "F("", line 1, characters 1-2:
Error: Syntax error

7
testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.ml Normal file
View File

@ -0,0 +1,7 @@
(* TEST
* setup-ocamlc.byte-build-env
** ocamlc.byte
flags = "-open F("
ocamlc_byte_exit_status = "2"
*** check-ocamlc.byte-output
*)

13
testsuite/tests/typing-extensions/extensions.ml
View File

@ -668,6 +668,19 @@ let y = x (* Prints Bar and part of Foo (which has been shadowed) *)
val y : exn * exn = (Foo (3, _), Bar (Some 5))
|}]
module Empty = struct end
module F(X:sig end) = struct
type t = ..
type t += A
end
let x = let open F(Empty) in (A:F(Empty).t) (* A is not printed *)
[%%expect {|
module Empty : sig end
module F : functor (X : sig end) -> sig type t = .. type t += A end
val x : F(Empty).t = <extension>
|}]
(* Test Obj functions *)
type foo = ..

7
toplevel/genprintval.ml
View File

@ -547,10 +547,15 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
else O.field bucket 0
in
let name = (O.obj(O.field slot 0) : string) in
let lid = Longident.parse name in
try
(* Attempt to recover the constructor description for the exn
from its name *)
let lid =
try Parse.longident (Lexing.from_string name) with
(* The syntactic class for extension constructor names
is an extended form of constructor "Longident.t"s
that also includes module application (e.g [F(X).A]) *)
| Syntaxerr.Error _ | Lexer.Error _ -> raise Not_found in
let cstr = Env.find_constructor_by_name lid env in
let path =
match cstr.cstr_tag with

7
typing/typemod.ml
View File

@ -150,8 +150,11 @@ let initial_env ~loc ~safe_string ~initially_opened_module
in
let open_module env m =
let open Asttypes in
let lid = {loc; txt = Longident.parse m } in
snd (type_open_ Override env lid.loc lid)
let lexbuf = Lexing.from_string m in
let txt =
Location.init lexbuf (Printf.sprintf "command line argument: -open %S" m);
Parse.simple_module_path lexbuf in
snd (type_open_ Override env loc {txt;loc})
in
let add_units env units =
String.Set.fold