Fix toplevel show directive to work with constructors
The show directive now has some basic facility to show useful information for constructors of "normal" values, exceptions and other non-exception extension constructors. Also updated show_type to print out recursion status with a default of Trec_first.master
parent
cfc1d4ce18
commit
f43323be52
4
Changes
4
Changes
|
@ -30,6 +30,10 @@ Working version
|
|||
- #8938: Extend ocamlopt option "-stop-after" to handle "scheduling" argument.
|
||||
(Greta Yorsh, review by Florian Angeletti and Sébastien Hinderer)
|
||||
|
||||
- #8945: Fix toplevel show directive to work with constructors
|
||||
(Simon Parry, review by Gabriel Scherer, Jeremy Yallop,
|
||||
Alain Frisch, Florian Angeletti)
|
||||
|
||||
### Internal/compiler-libs changes:
|
||||
|
||||
- #8970: separate value patterns (matching on values) from computation patterns
|
||||
|
|
|
@ -0,0 +1,106 @@
|
|||
(* TEST
|
||||
* expect
|
||||
*)
|
||||
|
||||
(* this is a set of tests to test the #show functionality
|
||||
* of toplevel *)
|
||||
|
||||
#show Foo;;
|
||||
[%%expect {|
|
||||
Unknown element.
|
||||
|}];;
|
||||
|
||||
module type S = sig type t val x : t end;;
|
||||
module M : S = struct type t = int let x = 3 end;;
|
||||
|
||||
[%%expect {|
|
||||
module type S = sig type t val x : t end
|
||||
module M : S
|
||||
|}];;
|
||||
|
||||
#show M;;
|
||||
[%%expect {|
|
||||
module M : S
|
||||
|}];;
|
||||
|
||||
#show S;;
|
||||
[%%expect {|
|
||||
module type S = sig type t val x : t end
|
||||
|}];;
|
||||
|
||||
#show Invalid_argument;;
|
||||
[%%expect {|
|
||||
exception Invalid_argument of string
|
||||
|}];;
|
||||
|
||||
#show Some;;
|
||||
[%%expect {|
|
||||
type 'a option = None | Some of 'a
|
||||
|}];;
|
||||
|
||||
#show option;;
|
||||
[%%expect {|
|
||||
type 'a option = None | Some of 'a
|
||||
|}];;
|
||||
|
||||
#show Open_binary;;
|
||||
[%%expect {|
|
||||
type Stdlib.open_flag =
|
||||
Open_rdonly
|
||||
| Open_wronly
|
||||
| Open_append
|
||||
| Open_creat
|
||||
| Open_trunc
|
||||
| Open_excl
|
||||
| Open_binary
|
||||
| Open_text
|
||||
| Open_nonblock
|
||||
|}];;
|
||||
|
||||
#show open_flag;;
|
||||
[%%expect {|
|
||||
type open_flag =
|
||||
Open_rdonly
|
||||
| Open_wronly
|
||||
| Open_append
|
||||
| Open_creat
|
||||
| Open_trunc
|
||||
| Open_excl
|
||||
| Open_binary
|
||||
| Open_text
|
||||
| Open_nonblock
|
||||
|}];;
|
||||
|
||||
type extensible = ..;;
|
||||
type extensible += A | B of int;;
|
||||
[%%expect {|
|
||||
type extensible = ..
|
||||
type extensible += A | B of int
|
||||
|}];;
|
||||
|
||||
#show A;;
|
||||
[%%expect {|
|
||||
type extensible += A
|
||||
|}];;
|
||||
|
||||
#show B;;
|
||||
[%%expect {|
|
||||
type extensible += B of int
|
||||
|}];;
|
||||
|
||||
#show extensible;;
|
||||
[%%expect {|
|
||||
type extensible = ..
|
||||
|}];;
|
||||
|
||||
type 'a t = ..;;
|
||||
type _ t += A : int t;;
|
||||
[%%expect{|
|
||||
type 'a t = ..
|
||||
type _ t += A : int t
|
||||
|}];;
|
||||
|
||||
#show A;;
|
||||
[%%expect{|
|
||||
type 'a t += A : int t
|
||||
|}];;
|
|
@ -545,15 +545,66 @@ let () =
|
|||
reg_show_prim "show_type"
|
||||
(fun env loc id lid ->
|
||||
let _path, desc = Env.lookup_type ~loc lid env in
|
||||
[ Sig_type (id, desc, Trec_not, Exported) ]
|
||||
[ Sig_type (id, desc, Trec_first, Exported) ]
|
||||
)
|
||||
"Print the signature of the corresponding type constructor."
|
||||
|
||||
(* Each registered show_prim function is called in turn
|
||||
* and any output produced is sent to std_out.
|
||||
* Two show_prim functions are needed for constructors,
|
||||
* one for exception constructors and another for
|
||||
* non-exception constructors (normal and extensible variants). *)
|
||||
let is_exception_constructor env type_expr =
|
||||
Ctype.equal env true [type_expr] [Predef.type_exn]
|
||||
|
||||
let is_extension_constructor = function
|
||||
| Cstr_extension _ -> true
|
||||
| _ -> false
|
||||
|
||||
let () =
|
||||
(* This show_prim function will only show constructor types
|
||||
* that are not also exception types. *)
|
||||
reg_show_prim "show_constructor"
|
||||
(fun env loc id lid ->
|
||||
let desc = Env.lookup_constructor ~loc Env.Positive lid env in
|
||||
if is_exception_constructor env desc.cstr_res then
|
||||
raise Not_found;
|
||||
let path =
|
||||
match Ctype.repr desc.cstr_res with
|
||||
| {desc=Tconstr(path, _, _)} -> path
|
||||
| _ -> raise Not_found
|
||||
in
|
||||
let type_decl = Env.find_type path env in
|
||||
if is_extension_constructor desc.cstr_tag then
|
||||
let ret_type =
|
||||
if desc.cstr_generalized then Some desc.cstr_res
|
||||
else None
|
||||
in
|
||||
let ext =
|
||||
{ ext_type_path = path;
|
||||
ext_type_params = type_decl.type_params;
|
||||
ext_args = Cstr_tuple desc.cstr_args;
|
||||
ext_ret_type = ret_type;
|
||||
ext_private = Asttypes.Public;
|
||||
Types.ext_loc = desc.cstr_loc;
|
||||
Types.ext_attributes = desc.cstr_attributes; }
|
||||
in
|
||||
[Sig_typext (id, ext, Text_first, Exported)]
|
||||
else
|
||||
(* make up a fake Ident.t as type_decl : Types.type_declaration
|
||||
* does not have an Ident.t yet. Ident.create_presistent is a
|
||||
* good choice because it has no side-effects.
|
||||
* *)
|
||||
let type_id = Ident.create_persistent (Path.name path) in
|
||||
[ Sig_type (type_id, type_decl, Trec_first, Exported) ]
|
||||
)
|
||||
"Print the signature of the corresponding value constructor."
|
||||
|
||||
let () =
|
||||
reg_show_prim "show_exception"
|
||||
(fun env loc id lid ->
|
||||
let desc = Env.lookup_constructor ~loc Env.Positive lid env in
|
||||
if not (Ctype.equal env true [desc.cstr_res] [Predef.type_exn]) then
|
||||
if not (is_exception_constructor env desc.cstr_res) then
|
||||
raise Not_found;
|
||||
let ret_type =
|
||||
if desc.cstr_generalized then Some Predef.type_exn
|
||||
|
|
Loading…
Reference in New Issue