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

Get rid of the undocumented syntax #c[>`A] (#5936, #5983). 

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13542 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2013-04-16 12:17:17 +00:00
parent 80c492fe64
commit 158bc9c9e3
20 changed files with 46 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
View File

@ -238,7 +238,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
| TyApp loc _ _ as f ->
let (f, al) = ctyp_fa [] f in
let (is_cls, li) = ctyp_long_id f in
if is_cls then mktyp loc (Ptyp_class li (List.map ctyp al) [])
if is_cls then mktyp loc (Ptyp_class li (List.map ctyp al))
else mktyp loc (Ptyp_constr li (List.map ctyp al))
| TyArr loc (TyLab _ lab t1) t2 ->
mktyp loc (Ptyp_arrow lab (ctyp t1) (ctyp t2))
@ -250,7 +250,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
| <:ctyp@loc< < $fl$ .. > >> ->
mktyp loc (Ptyp_object (meth_list fl []) Open)
| TyCls loc id ->
mktyp loc (Ptyp_class (ident id) [] [])
mktyp loc (Ptyp_class (ident id) [])
| <:ctyp@loc< (module $pt$) >> ->
let (i, cs) = package_type pt in
mktyp loc (Ptyp_package i cs)
@ -660,8 +660,8 @@ value varify_constructors var_names =
Ptyp_constr longident (List.map loop lst)
| Ptyp_object (lst, o) ->
Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
| Ptyp_class longident lst lbl_list ->
Ptyp_class (longident, List.map loop lst, lbl_list)
| Ptyp_class longident lst ->
Ptyp_class (longident, List.map loop lst)
| Ptyp_alias core_type string ->
Ptyp_alias(loop core_type, string)
| Ptyp_variant row_field_list flag lbl_lst_option ->

8
camlp4/boot/Camlp4.ml
View File

@ -14363,7 +14363,7 @@ module Struct =
let (is_cls, li) = ctyp_long_id f
in
if is_cls
then mktyp loc (Ptyp_class (li, (List.map ctyp al), []))
then mktyp loc (Ptyp_class (li, (List.map ctyp al)))
else mktyp loc (Ptyp_constr (li, (List.map ctyp al)))
| TyArr (loc, (TyLab (_, lab, t1)), t2) ->
mktyp loc (Ptyp_arrow (lab, (ctyp t1), (ctyp t2)))
@ -14380,7 +14380,7 @@ module Struct =
mktyp loc
(Ptyp_object (meth_list fl [], Open))
| TyCls (loc, id) ->
mktyp loc (Ptyp_class ((ident id), [], []))
mktyp loc (Ptyp_class ((ident id), []))
| Ast.TyPkg (loc, pt) ->
let (i, cs) = package_type pt
in mktyp loc (Ptyp_package (i, cs))
@ -14884,8 +14884,8 @@ module Struct =
Ptyp_constr (longident, (List.map loop lst))
| Ptyp_object (lst, o) ->
Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
| Ptyp_class (longident, lst, lbl_list) ->
Ptyp_class ((longident, (List.map loop lst), lbl_list))
| Ptyp_class (longident, lst) ->
Ptyp_class ((longident, (List.map loop lst)))
| Ptyp_alias (core_type, string) ->
Ptyp_alias (((loop core_type), string))
| Ptyp_variant (row_field_list, flag, lbl_lst_option) ->

8
experimental/frisch/extension_points.txt
View File

@ -421,6 +421,10 @@ Rationale:
- Make it explicit when the guard can appear.
--- Get rid of "fun p when guard -> e"
See #5939, #5936.
--- Get rid of the location argument on pci_params
@ -436,6 +440,10 @@ invariants in the Parsetree (such as: := constraints cannot be on qualified
identifiers). Also, we avoid mixing in a single Longident.t identifier
which can be LIDENT or UIDENT.
--- Get rid of the "#c [> `A]" syntax
See #5936, #5983.
=== More TODOs

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

@ -122,7 +122,7 @@ let rec search_pos_type t ~pos ~env =
add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
| Ptyp_object (fl, _) ->
List.iter fl ~f:(fun (_, ty) -> search_pos_type ty ~pos ~env)
| Ptyp_class (lid, tl, _) ->
| Ptyp_class (lid, tl) ->
List.iter tl ~f:(search_pos_type ~pos ~env);
add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
| Ptyp_alias (t, _)

2
parsing/ast_helper.ml
View File

@ -38,7 +38,7 @@ module Typ = struct
let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
let class_ ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_class (a, b, c))
let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b))
let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))
let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))

2
parsing/ast_helper.mli
View File

@ -37,7 +37,7 @@ module Typ :
val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
val object_: ?loc:loc -> ?attrs:attrs -> (string * core_type) list -> closed_flag -> core_type
val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> label list -> core_type
val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type
val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type
val poly: ?loc:loc -> ?attrs:attrs -> string list -> core_type -> core_type

2
parsing/ast_mapper.ml
View File

@ -44,7 +44,7 @@ module T = struct
| Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub # typ) tyl)
| Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl)
| Ptyp_object (l, o) -> object_ ~loc ~attrs (List.map (map_snd (sub # typ)) l) o
| Ptyp_class (lid, tl, ll) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) ll
| Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl)
| Ptyp_alias (t, s) -> alias ~loc ~attrs (sub # typ t) s
| Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll
| Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub # typ t)

20
parsing/parser.mly
View File

@ -249,8 +249,8 @@ let varify_constructors var_names t =
Ptyp_constr(longident, List.map loop lst)
| Ptyp_object (lst, o) ->
Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
| Ptyp_class (longident, lst, lbl_list) ->
Ptyp_class (longident, List.map loop lst, lbl_list)
| Ptyp_class (longident, lst) ->
Ptyp_class (longident, List.map loop lst)
| Ptyp_alias(core_type, string) ->
check_variable var_names t.ptyp_loc string;
Ptyp_alias(loop core_type, string)
@ -1645,12 +1645,12 @@ simple_core_type2:
{ let (f, c) = $2 in mktyp(Ptyp_object (f, c)) }
| LESS GREATER
{ mktyp(Ptyp_object ([], Closed)) }
| SHARP class_longident opt_present
{ mktyp(Ptyp_class(mkrhs $2 2, [], $3)) }
| simple_core_type2 SHARP class_longident opt_present
{ mktyp(Ptyp_class(mkrhs $3 3, [$1], $4)) }
| LPAREN core_type_comma_list RPAREN SHARP class_longident opt_present
{ mktyp(Ptyp_class(mkrhs $5 5, List.rev $2, $6)) }
| SHARP class_longident
{ mktyp(Ptyp_class(mkrhs $2 2, [])) }
| simple_core_type2 SHARP class_longident
{ mktyp(Ptyp_class(mkrhs $3 3, [$1])) }
| LPAREN core_type_comma_list RPAREN SHARP class_longident
{ mktyp(Ptyp_class(mkrhs $5 5, List.rev $2)) }
| LBRACKET tag_field RBRACKET
{ mktyp(Ptyp_variant([$2], Closed, None)) }
/* PR#3835: this is not LR(1), would need lookahead=2
@ -1707,10 +1707,6 @@ amper_type_list:
core_type { [$1] }
| amper_type_list AMPERSAND core_type { $3 :: $1 }
;
opt_present:
LBRACKETGREATER name_tag_list RBRACKET { List.rev $2 }
| /* empty */ { [] }
;
name_tag_list:
name_tag { [$1] }
| name_tag_list name_tag { $2 :: $1 }

7
parsing/parsetree.mli
View File

@ -66,13 +66,10 @@ and core_type_desc =
(* < l1:T1; ...; ln:Tn > (flag = Closed)
< l1:T1; ...; ln:Tn; .. > (flag = Open)
*)
| Ptyp_class of Longident.t loc * core_type list * label list
| Ptyp_class of Longident.t loc * core_type list
(* #tconstr
T #tconstr
(T1, ..., Tn) tconstr
The label list is used for the deprecated syntax:
#tconstr [> `A1 ... `An]
(T1, ..., Tn) #tconstr
*)
| Ptyp_alias of core_type * string
(* T as 'a *)

7
parsing/pprintast.ml
View File

@ -297,13 +297,10 @@ class printer ()= object(self:'self)
in
pp f "@[<hov2><@ %a%a@ >@]" (self#list core_field_type ~sep:";") l
field_var o
| Ptyp_class (li, l, low) -> (*FIXME*)
pp f "@[<hov2>%a#%a%a@]"
| Ptyp_class (li, l) -> (*FIXME*)
pp f "@[<hov2>%a#%a@]"
(self#list self#core_type ~sep:"," ~first:"(" ~last:")") l
self#longident_loc li
(fun f low -> match low with
| [] -> ()
| _ -> pp f "@ [>@ %a]" (self#list self#string_quot) low) low
| Ptyp_package (lid, cstrs) ->
let aux f (s, ct) =
pp f "type %a@ =@ %a" self#longident_loc s self#core_type ct in

5
parsing/printast.ml
View File

@ -162,10 +162,9 @@ let rec core_type i ppf x =
core_type (i + 1) ppf t
)
l
| Ptyp_class (li, l, low) ->
| Ptyp_class (li, l) ->
line i ppf "Ptyp_class %a\n" fmt_longident_loc li;
list i core_type ppf l;
list i string ppf low
list i core_type ppf l
| Ptyp_alias (ct, s) ->
line i ppf "Ptyp_alias \"%s\"\n" s;
core_type i ppf ct;

2
tools/depend.ml
View File

@ -44,7 +44,7 @@ let rec add_type bv ty =
| Ptyp_tuple tl -> List.iter (add_type bv) tl
| Ptyp_constr(c, tl) -> add bv c; List.iter (add_type bv) tl
| Ptyp_object (fl, _) -> List.iter (fun (_, t) -> add_type bv t) fl
| Ptyp_class(c, tl, _) -> add bv c; List.iter (add_type bv) tl
| Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
| Ptyp_alias(t, s) -> add_type bv t
| Ptyp_variant(fl, _, _) ->
List.iter

2
tools/tast_iter.ml
View File

@ -288,7 +288,7 @@ let core_type sub ct =
List.iter (sub # core_type) list
| Ttyp_object (list, _o) ->
List.iter (fun (_, t) -> sub # core_type t) list
| Ttyp_class (_path, _, list, _labels) ->
| Ttyp_class (_path, _, list) ->
List.iter (sub # core_type) list
| Ttyp_alias (ct, _s) ->
sub # core_type ct

5
tools/untypeast.ml
View File

@ -496,9 +496,8 @@ and untype_core_type ct =
List.map untype_core_type list)
| Ttyp_object (list, o) ->
Ptyp_object (List.map (fun (s, t) -> (s, untype_core_type t)) list, o)
| Ttyp_class (_path, lid, list, labels) ->
Ptyp_class (lid,
List.map untype_core_type list, labels)
| Ttyp_class (_path, lid, list) ->
Ptyp_class (lid, List.map untype_core_type list)
| Ttyp_alias (ct, s) ->
Ptyp_alias (untype_core_type ct, s)
| Ttyp_variant (list, bool, labels) ->

3
typing/printtyped.ml
View File

@ -176,10 +176,9 @@ let rec core_type i ppf x =
core_type (i + 1) ppf t
)
l
| Ttyp_class (li, _, l, low) ->
| Ttyp_class (li, _, l) ->
line i ppf "Ptyp_class %a\n" fmt_path li;
list i core_type ppf l;
list i string ppf low
| Ttyp_alias (ct, s) ->
line i ppf "Ptyp_alias \"%s\"\n" s;
core_type i ppf ct;

2
typing/typedtree.ml
View File

@ -321,7 +321,7 @@ and core_type_desc =
| Ttyp_tuple of core_type list
| Ttyp_constr of Path.t * Longident.t loc * core_type list
| Ttyp_object of (string * core_type) list * closed_flag
| Ttyp_class of Path.t * Longident.t loc * core_type list * label list
| Ttyp_class of Path.t * Longident.t loc * core_type list
| Ttyp_alias of core_type * string
| Ttyp_variant of row_field list * closed_flag * label list option
| Ttyp_poly of string list * core_type

2
typing/typedtree.mli
View File

@ -320,7 +320,7 @@ and core_type_desc =
| Ttyp_tuple of core_type list
| Ttyp_constr of Path.t * Longident.t loc * core_type list
| Ttyp_object of (string * core_type) list * closed_flag
| Ttyp_class of Path.t * Longident.t loc * core_type list * label list
| Ttyp_class of Path.t * Longident.t loc * core_type list
| Ttyp_alias of core_type * string
| Ttyp_variant of row_field list * closed_flag * label list option
| Ttyp_poly of string list * core_type

2
typing/typedtreeIter.ml
View File

@ -513,7 +513,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
List.iter iter_core_type list
| Ttyp_object (list, o) ->
List.iter (fun (_, t) -> iter_core_type t) list
| Ttyp_class (path, _, list, labels) ->
| Ttyp_class (path, _, list) ->
List.iter iter_core_type list
| Ttyp_alias (ct, s) ->
iter_core_type ct

4
typing/typedtreeMap.ml
View File

@ -555,8 +555,8 @@ module MakeMap(Map : MapArgument) = struct
Ttyp_constr (path, lid, List.map map_core_type list)
| Ttyp_object (list, o) ->
Ttyp_object (List.map (fun (s, t) -> (s, map_core_type t)) list, o)
| Ttyp_class (path, lid, list, labels) ->
Ttyp_class (path, lid, List.map map_core_type list, labels)
| Ttyp_class (path, lid, list) ->
Ttyp_class (path, lid, List.map map_core_type list)
| Ttyp_alias (ct, s) -> Ttyp_alias (map_core_type ct, s)
| Ttyp_variant (list, bool, labels) ->
Ttyp_variant (List.map map_row_field list, bool, labels)

10
typing/typetexp.ml
View File

@ -285,7 +285,7 @@ let rec transl_type env policy styp =
in
let ty = newobj (transl_fields loc env policy [] o fields) in
ctyp (Ttyp_object (fields, o)) ty
| Ptyp_class(lid, stl, present) ->
| Ptyp_class(lid, stl) ->
let (path, decl, is_variant) =
try
let (path, decl) = Env.lookup_type lid.txt env in
@ -302,7 +302,6 @@ let rec transl_type env policy styp =
Location.prerr_warning styp.ptyp_loc Warnings.Deprecated;
(path, decl,true)
with Not_found -> try
if present <> [] then raise Not_found;
let lid2 =
match lid.txt with
Longident.Lident s -> Longident.Lident ("#" ^ s)
@ -334,14 +333,9 @@ let rec transl_type env policy styp =
let ty = match ty.desc with
Tvariant row ->
let row = Btype.row_repr row in
List.iter
(fun l -> if not (List.mem_assoc l row.row_fields) then
raise(Error(styp.ptyp_loc, env, Present_has_no_type l)))
present;
let fields =
List.map
(fun (l,f) -> l,
if List.mem l present then f else
match Btype.row_field_repr f with
| Rpresent (Some ty) ->
Reither(false, [ty], false, ref None)
@ -367,7 +361,7 @@ let rec transl_type env policy styp =
| _ ->
assert false
in
ctyp (Ttyp_class (path, lid, args, present)) ty
ctyp (Ttyp_class (path, lid, args)) ty
| Ptyp_alias(st, alias) ->
let cty =
try