Merge pull request #301 from alainfrisch/let_exception
Local exceptions (without the optimization)master
commit
b791a20b69
34
.depend
34
.depend
|
@ -347,23 +347,25 @@ typing/typeclass.cmi : typing/types.cmi typing/typedtree.cmi \
|
|||
parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
|
||||
typing/ident.cmi typing/env.cmi typing/ctype.cmi parsing/asttypes.cmi
|
||||
typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \
|
||||
typing/types.cmi typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \
|
||||
typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
|
||||
typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi \
|
||||
typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \
|
||||
parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
|
||||
typing/cmt_format.cmi utils/clflags.cmi parsing/builtin_attributes.cmi \
|
||||
typing/btype.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
|
||||
typing/annot.cmi typing/typecore.cmi
|
||||
typing/types.cmi typing/typedtree.cmi typing/typedecl.cmi \
|
||||
typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \
|
||||
typing/primitive.cmi typing/predef.cmi typing/path.cmi \
|
||||
parsing/parsetree.cmi typing/parmatch.cmi typing/oprint.cmi \
|
||||
utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
|
||||
typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \
|
||||
utils/clflags.cmi parsing/builtin_attributes.cmi typing/btype.cmi \
|
||||
parsing/asttypes.cmi parsing/ast_helper.cmi typing/annot.cmi \
|
||||
typing/typecore.cmi
|
||||
typing/typecore.cmx : utils/warnings.cmx typing/typetexp.cmx \
|
||||
typing/types.cmx typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \
|
||||
typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
|
||||
typing/path.cmx parsing/parsetree.cmi typing/parmatch.cmx \
|
||||
typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \
|
||||
parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
|
||||
typing/cmt_format.cmx utils/clflags.cmx parsing/builtin_attributes.cmx \
|
||||
typing/btype.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
|
||||
typing/annot.cmi typing/typecore.cmi
|
||||
typing/types.cmx typing/typedtree.cmx typing/typedecl.cmx \
|
||||
typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx \
|
||||
typing/primitive.cmx typing/predef.cmx typing/path.cmx \
|
||||
parsing/parsetree.cmi typing/parmatch.cmx typing/oprint.cmx \
|
||||
utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
|
||||
typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \
|
||||
utils/clflags.cmx parsing/builtin_attributes.cmx typing/btype.cmx \
|
||||
parsing/asttypes.cmi parsing/ast_helper.cmx typing/annot.cmi \
|
||||
typing/typecore.cmi
|
||||
typing/typecore.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \
|
||||
parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
|
||||
typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/annot.cmi
|
||||
|
|
4
Changes
4
Changes
|
@ -3,6 +3,10 @@ OCaml 4.04.0:
|
|||
|
||||
(Changes that can break existing programs are marked with a "*")
|
||||
|
||||
Language features:
|
||||
- GPR#301: local exception declarations "let exception ... in"
|
||||
(Alain Frisch)
|
||||
|
||||
Tools:
|
||||
- GPR#452: Make the output of ocamldep is more stable (Alain Frisch)
|
||||
|
||||
|
|
|
@ -66,8 +66,8 @@ TYPING=typing/ident.cmo typing/path.cmo \
|
|||
typing/tast_mapper.cmo \
|
||||
typing/cmt_format.cmo typing/untypeast.cmo \
|
||||
typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \
|
||||
typing/stypes.cmo typing/typecore.cmo \
|
||||
typing/typedecl.cmo typing/typeclass.cmo \
|
||||
typing/stypes.cmo typing/typedecl.cmo typing/typecore.cmo \
|
||||
typing/typeclass.cmo \
|
||||
typing/typemod.cmo
|
||||
|
||||
COMP=bytecomp/lambda.cmo bytecomp/printlambda.cmo \
|
||||
|
|
|
@ -44,6 +44,26 @@ let transl_object =
|
|||
ref (fun id s cl -> assert false :
|
||||
Ident.t -> string list -> class_expr -> lambda)
|
||||
|
||||
(* Compile an exception/extension definition *)
|
||||
|
||||
let prim_fresh_oo_id =
|
||||
Pccall (Primitive.simple ~name:"caml_fresh_oo_id" ~arity:1 ~alloc:false)
|
||||
|
||||
let transl_extension_constructor env path ext =
|
||||
let name =
|
||||
match path, !Clflags.for_package with
|
||||
None, _ -> Ident.name ext.ext_id
|
||||
| Some p, None -> Path.name p
|
||||
| Some p, Some pack -> Printf.sprintf "%s.%s" pack (Path.name p)
|
||||
in
|
||||
match ext.ext_kind with
|
||||
Text_decl(args, ret) ->
|
||||
Lprim (Pmakeblock (Obj.object_tag, Immutable),
|
||||
[Lconst (Const_base (Const_string (name, None)));
|
||||
Lprim (prim_fresh_oo_id, [Lconst (Const_base (Const_int 0))])])
|
||||
| Text_rebind(path, lid) ->
|
||||
transl_path ~loc:ext.ext_loc env path
|
||||
|
||||
(* Translation of primitives *)
|
||||
|
||||
let comparisons_table = create_hashtable 11 [
|
||||
|
@ -957,6 +977,9 @@ and transl_exp0 e =
|
|||
(Lvar cpy))
|
||||
| Texp_letmodule(id, _, modl, body) ->
|
||||
Llet(Strict, id, !transl_module Tcoerce_none None modl, transl_exp body)
|
||||
| Texp_letexception(cd, body) ->
|
||||
Llet(Strict, cd.ext_id, transl_extension_constructor e.exp_env None cd,
|
||||
transl_exp body)
|
||||
| Texp_pack modl ->
|
||||
!transl_module Tcoerce_none None modl
|
||||
| Texp_assert {exp_desc=Texp_construct(_, {cstr_name="false"}, _)} ->
|
||||
|
|
|
@ -30,6 +30,9 @@ val transl_let: rec_flag -> value_binding list -> lambda -> lambda
|
|||
val transl_primitive: Location.t -> Primitive.description -> Env.t
|
||||
-> Types.type_expr -> Path.t option -> lambda
|
||||
|
||||
val transl_extension_constructor: Env.t -> Path.t option ->
|
||||
extension_constructor -> lambda
|
||||
|
||||
val check_recursive_lambda: Ident.t list -> lambda -> bool
|
||||
|
||||
val used_primitives: (Path.t, Location.t) Hashtbl.t
|
||||
|
|
|
@ -48,24 +48,6 @@ let field_path path field =
|
|||
|
||||
(* Compile type extensions *)
|
||||
|
||||
let prim_fresh_oo_id =
|
||||
Pccall (Primitive.simple ~name:"caml_fresh_oo_id" ~arity:1 ~alloc:false)
|
||||
|
||||
let transl_extension_constructor env path ext =
|
||||
let name =
|
||||
match path, !Clflags.for_package with
|
||||
None, _ -> Ident.name ext.ext_id
|
||||
| Some p, None -> Path.name p
|
||||
| Some p, Some pack -> Printf.sprintf "%s.%s" pack (Path.name p)
|
||||
in
|
||||
match ext.ext_kind with
|
||||
Text_decl(args, ret) ->
|
||||
Lprim (Pmakeblock (Obj.object_tag, Immutable),
|
||||
[Lconst (Const_base (Const_string (name, None)));
|
||||
Lprim (prim_fresh_oo_id, [Lconst (Const_base (Const_int 0))])])
|
||||
| Text_rebind(path, lid) ->
|
||||
transl_path ~loc:ext.ext_loc env path
|
||||
|
||||
let transl_type_extension env rootpath tyext body =
|
||||
List.fold_right
|
||||
(fun ext body ->
|
||||
|
|
|
@ -1503,7 +1503,7 @@ typedef: ...
|
|||
| typedef item-attribute
|
||||
;
|
||||
exception-definition:
|
||||
'exception' constr-name { attribute } [ 'of' typexpr { '*' typexpr } ]
|
||||
'exception' constr-decl
|
||||
| 'exception' constr-name '=' constr
|
||||
;
|
||||
module-items:
|
||||
|
@ -2096,3 +2096,25 @@ let invalid = function
|
|||
| Point p -> p (* INVALID *)
|
||||
| ...
|
||||
\end{verbatim}
|
||||
|
||||
|
||||
\section{Local exceptions}
|
||||
\ikwd{let\@\texttt{let}}
|
||||
\ikwd{exception\@\texttt{exception}}
|
||||
|
||||
(Introduced in OCaml 4.04)
|
||||
|
||||
It is possible to define local exceptions in expressions:
|
||||
|
||||
\begin{syntax}
|
||||
expr:
|
||||
...
|
||||
| "let" "exception" constr-decl "in" expr
|
||||
\end{syntax}
|
||||
|
||||
|
||||
The syntactic scope of the exception constructor is the inner
|
||||
expression, but nothing prevents exception values created with this
|
||||
constructor from escaping this scope. Two executions of the definition
|
||||
above result in two incompatible exception constructors (as for any
|
||||
exception definition).
|
||||
|
|
|
@ -201,7 +201,7 @@ appear in the type equation and the type declaration.
|
|||
|
||||
\begin{syntax}
|
||||
exception-definition:
|
||||
'exception' constr-name [ 'of' typexpr { '*' typexpr } ]
|
||||
'exception' constr-decl
|
||||
| 'exception' constr-name '=' constr
|
||||
\end{syntax}
|
||||
|
||||
|
@ -209,7 +209,7 @@ Exception definitions add new constructors to the built-in variant
|
|||
type \verb"exn" of exception values. The constructors are declared as
|
||||
for a definition of a variant type.
|
||||
|
||||
The form @'exception' constr-name ['of' typexpr {'*' typexpr}]@
|
||||
The form @'exception' constr-decl@
|
||||
generates a new exception, distinct from all other exceptions in the system.
|
||||
The form @'exception' constr-name '=' constr@
|
||||
gives an alternate name to an existing exception.
|
||||
|
|
|
@ -122,6 +122,7 @@ module Exp = struct
|
|||
let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b))
|
||||
let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a)
|
||||
let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c))
|
||||
let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b))
|
||||
let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a)
|
||||
let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a)
|
||||
let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b))
|
||||
|
|
|
@ -149,6 +149,8 @@ module Exp:
|
|||
-> expression
|
||||
val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression
|
||||
-> expression
|
||||
val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression
|
||||
-> expression
|
||||
val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression
|
||||
val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression
|
||||
val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option
|
||||
|
|
|
@ -355,6 +355,9 @@ module E = struct
|
|||
| Pexp_letmodule (s, me, e) ->
|
||||
iter_loc sub s; sub.module_expr sub me;
|
||||
sub.expr sub e
|
||||
| Pexp_letexception (cd, e) ->
|
||||
sub.extension_constructor sub cd;
|
||||
sub.expr sub e
|
||||
| Pexp_assert e -> sub.expr sub e
|
||||
| Pexp_lazy e -> sub.expr sub e
|
||||
| Pexp_poly (e, t) ->
|
||||
|
|
|
@ -370,6 +370,10 @@ module E = struct
|
|||
| Pexp_letmodule (s, me, e) ->
|
||||
letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me)
|
||||
(sub.expr sub e)
|
||||
| Pexp_letexception (cd, e) ->
|
||||
letexception ~loc ~attrs
|
||||
(sub.extension_constructor sub cd)
|
||||
(sub.expr sub e)
|
||||
| Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e)
|
||||
| Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e)
|
||||
| Pexp_poly (e, t) ->
|
||||
|
|
|
@ -1354,6 +1354,15 @@ expr:
|
|||
{ expr_of_let_bindings $1 $3 }
|
||||
| LET MODULE ext_attributes UIDENT module_binding_body IN seq_expr
|
||||
{ mkexp_attrs (Pexp_letmodule(mkrhs $4 4, $5, $7)) $3 }
|
||||
| LET EXCEPTION ext_attributes constr_ident generalized_constructor_arguments
|
||||
attributes IN seq_expr
|
||||
{ let args, res = $5 in
|
||||
let ex =
|
||||
Te.decl (mkrhs $4 4) ~args ?res ~attrs:$6
|
||||
~loc:(symbol_rloc())
|
||||
in
|
||||
mkexp_attrs (Pexp_letexception(ex, $8)) $3
|
||||
}
|
||||
| LET OPEN override_flag ext_attributes mod_longident IN seq_expr
|
||||
{ mkexp_attrs (Pexp_open($3, mkrhs $5 5, $7)) $4 }
|
||||
| FUNCTION ext_attributes opt_bar match_cases
|
||||
|
@ -1616,7 +1625,7 @@ let_binding_body:
|
|||
| val_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
|
||||
{ let exp, poly = wrap_type_annotation $4 $6 $8 in
|
||||
(ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp) }
|
||||
| pattern EQUAL seq_expr
|
||||
| pattern_no_exn EQUAL seq_expr
|
||||
{ ($1, $3) }
|
||||
| simple_pattern_not_ident COLON core_type EQUAL seq_expr
|
||||
{ (ghpat(Ppat_constraint($1, $3)), $5) }
|
||||
|
@ -1722,36 +1731,58 @@ opt_type_constraint:
|
|||
/* Patterns */
|
||||
|
||||
pattern:
|
||||
simple_pattern
|
||||
{ $1 }
|
||||
| pattern AS val_ident
|
||||
{ mkpat(Ppat_alias($1, mkrhs $3 3)) }
|
||||
| pattern AS error
|
||||
{ expecting 3 "identifier" }
|
||||
| pattern_comma_list %prec below_COMMA
|
||||
{ mkpat(Ppat_tuple(List.rev $1)) }
|
||||
| constr_longident pattern %prec prec_constr_appl
|
||||
{ mkpat(Ppat_construct(mkrhs $1 1, Some $2)) }
|
||||
| name_tag pattern %prec prec_constr_appl
|
||||
{ mkpat(Ppat_variant($1, Some $2)) }
|
||||
| pattern COLONCOLON pattern
|
||||
{ mkpat_cons (rhs_loc 2) (ghpat(Ppat_tuple[$1;$3])) (symbol_rloc()) }
|
||||
| pattern COLONCOLON error
|
||||
{ expecting 3 "pattern" }
|
||||
| LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern RPAREN
|
||||
{ mkpat_cons (rhs_loc 2) (ghpat(Ppat_tuple[$5;$7])) (symbol_rloc()) }
|
||||
| LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern error
|
||||
{ unclosed "(" 4 ")" 8 }
|
||||
| pattern BAR pattern
|
||||
{ mkpat(Ppat_or($1, $3)) }
|
||||
| pattern BAR error
|
||||
{ expecting 3 "pattern" }
|
||||
| LAZY ext_attributes simple_pattern
|
||||
{ mkpat_attrs (Ppat_lazy $3) $2}
|
||||
| EXCEPTION ext_attributes pattern %prec prec_constr_appl
|
||||
{ mkpat_attrs (Ppat_exception $3) $2}
|
||||
| pattern attribute
|
||||
{ Pat.attr $1 $2 }
|
||||
| pattern_gen { $1 }
|
||||
;
|
||||
pattern_no_exn:
|
||||
| pattern_no_exn AS val_ident
|
||||
{ mkpat(Ppat_alias($1, mkrhs $3 3)) }
|
||||
| pattern_no_exn AS error
|
||||
{ expecting 3 "identifier" }
|
||||
| pattern_no_exn_comma_list %prec below_COMMA
|
||||
{ mkpat(Ppat_tuple(List.rev $1)) }
|
||||
| pattern_no_exn COLONCOLON pattern
|
||||
{ mkpat_cons (rhs_loc 2) (ghpat(Ppat_tuple[$1;$3])) (symbol_rloc()) }
|
||||
| pattern_no_exn COLONCOLON error
|
||||
{ expecting 3 "pattern" }
|
||||
| pattern_no_exn BAR pattern
|
||||
{ mkpat(Ppat_or($1, $3)) }
|
||||
| pattern_no_exn BAR error
|
||||
{ expecting 3 "pattern" }
|
||||
| pattern_no_exn attribute
|
||||
{ Pat.attr $1 $2 }
|
||||
| pattern_gen { $1 }
|
||||
;
|
||||
pattern_gen:
|
||||
simple_pattern
|
||||
{ $1 }
|
||||
| constr_longident pattern %prec prec_constr_appl
|
||||
{ mkpat(Ppat_construct(mkrhs $1 1, Some $2)) }
|
||||
| name_tag pattern %prec prec_constr_appl
|
||||
{ mkpat(Ppat_variant($1, Some $2)) }
|
||||
| LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern RPAREN
|
||||
{ mkpat_cons (rhs_loc 2) (ghpat(Ppat_tuple[$5;$7])) (symbol_rloc()) }
|
||||
| LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern error
|
||||
{ unclosed "(" 4 ")" 8 }
|
||||
| LAZY ext_attributes simple_pattern
|
||||
{ mkpat_attrs (Ppat_lazy $3) $2}
|
||||
;
|
||||
simple_pattern:
|
||||
val_ident %prec below_EQUAL
|
||||
|
@ -1813,6 +1844,11 @@ pattern_comma_list:
|
|||
| pattern COMMA pattern { [$3; $1] }
|
||||
| pattern COMMA error { expecting 3 "pattern" }
|
||||
;
|
||||
pattern_no_exn_comma_list:
|
||||
pattern_no_exn_comma_list COMMA pattern { $3 :: $1 }
|
||||
| pattern_no_exn COMMA pattern { [$3; $1] }
|
||||
| pattern_no_exn COMMA error { expecting 3 "pattern" }
|
||||
;
|
||||
pattern_semi_list:
|
||||
pattern { [$1] }
|
||||
| pattern_semi_list SEMI pattern { $3 :: $1 }
|
||||
|
|
|
@ -318,6 +318,8 @@ and expression_desc =
|
|||
(* {< x1 = E1; ...; Xn = En >} *)
|
||||
| Pexp_letmodule of string loc * module_expr * expression
|
||||
(* let module M = ME in E *)
|
||||
| Pexp_letexception of extension_constructor * expression
|
||||
(* let exception C in E *)
|
||||
| Pexp_assert of expression
|
||||
(* assert E
|
||||
Note: "assert false" is treated in a special way by the
|
||||
|
|
|
@ -475,7 +475,7 @@ class printer ()= object(self:'self)
|
|||
self#paren true self#reset#expression f x
|
||||
| Pexp_ifthenelse _ | Pexp_sequence _ when ifthenelse ->
|
||||
self#paren true self#reset#expression f x
|
||||
| Pexp_let _ | Pexp_letmodule _ when semi ->
|
||||
| Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ when semi ->
|
||||
self#paren true self#reset#expression f x
|
||||
| Pexp_fun (l, e0, p, e) ->
|
||||
pp f "@[<2>fun@;%a@;->@;%a@]"
|
||||
|
@ -571,6 +571,10 @@ class printer ()= object(self:'self)
|
|||
| Pexp_letmodule (s, me, e) ->
|
||||
pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]" s.txt
|
||||
self#reset#module_expr me self#expression e
|
||||
| Pexp_letexception (cd, e) ->
|
||||
pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
|
||||
self#extension_constructor cd
|
||||
self#expression e
|
||||
| Pexp_assert e ->
|
||||
pp f "@[<hov2>assert@ %a@]" self#simple_expr e
|
||||
| Pexp_lazy (e) ->
|
||||
|
|
|
@ -341,6 +341,10 @@ and expression i ppf x =
|
|||
line i ppf "Pexp_letmodule %a\n" fmt_string_loc s;
|
||||
module_expr i ppf me;
|
||||
expression i ppf e;
|
||||
| Pexp_letexception (cd, e) ->
|
||||
line i ppf "Pexp_letexception\n";
|
||||
extension_constructor i ppf cd;
|
||||
expression i ppf e;
|
||||
| Pexp_assert (e) ->
|
||||
line i ppf "Pexp_assert\n";
|
||||
expression i ppf e;
|
||||
|
|
|
@ -0,0 +1,25 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* OCaml *)
|
||||
(* *)
|
||||
(* Alain Frisch, LexiFi *)
|
||||
(* *)
|
||||
(* Copyright 1995 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique. *)
|
||||
(* *)
|
||||
(* All rights reserved. This file is distributed under the terms of *)
|
||||
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||
(* special exception on linking described in the file LICENSE. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
|
||||
let f (type t) () =
|
||||
let exception E of t in
|
||||
(fun x -> E x), (function E _ -> print_endline "OK" | _ -> print_endline "KO")
|
||||
|
||||
let inj1, proj1 = f ()
|
||||
let inj2, proj2 = f ()
|
||||
|
||||
let () = proj1 (inj1 42)
|
||||
let () = proj1 (inj2 42)
|
|
@ -0,0 +1,2 @@
|
|||
OK
|
||||
KO
|
|
@ -251,6 +251,7 @@ let rec add_expr bv exp =
|
|||
| Pexp_letmodule(id, m, e) ->
|
||||
let b = add_module_binding bv m in
|
||||
add_expr (StringMap.add id.txt b bv) e
|
||||
| Pexp_letexception(_, e) -> add_expr bv e
|
||||
| Pexp_assert (e) -> add_expr bv e
|
||||
| Pexp_lazy (e) -> add_expr bv e
|
||||
| Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
|
||||
|
|
|
@ -284,6 +284,9 @@ and rw_exp iflag sexp =
|
|||
rewrite_mod iflag smod;
|
||||
rewrite_exp iflag sexp
|
||||
|
||||
| Pexp_letexception (_cd, exp) ->
|
||||
rewrite_exp iflag exp
|
||||
|
||||
| Pexp_assert (cond) -> rewrite_exp iflag cond
|
||||
|
||||
| Pexp_lazy (expr) -> rewrite_exp iflag expr
|
||||
|
|
|
@ -362,6 +362,10 @@ and expression i ppf x =
|
|||
line i ppf "Texp_letmodule \"%a\"\n" fmt_ident s;
|
||||
module_expr i ppf me;
|
||||
expression i ppf e;
|
||||
| Texp_letexception (cd, e) ->
|
||||
line i ppf "Pexp_letexception\n";
|
||||
extension_constructor i ppf cd;
|
||||
expression i ppf e;
|
||||
| Texp_assert (e) ->
|
||||
line i ppf "Texp_assert";
|
||||
expression i ppf e;
|
||||
|
|
|
@ -323,6 +323,11 @@ let expr sub x =
|
|||
sub.module_expr sub mexpr,
|
||||
sub.expr sub exp
|
||||
)
|
||||
| Texp_letexception (cd, exp) ->
|
||||
Texp_letexception (
|
||||
sub.extension_constructor sub cd,
|
||||
sub.expr sub exp
|
||||
)
|
||||
| Texp_assert exp ->
|
||||
Texp_assert (sub.expr sub exp)
|
||||
| Texp_lazy exp ->
|
||||
|
|
|
@ -166,6 +166,7 @@ let iter_expression f e =
|
|||
| Pexp_send (e, _)
|
||||
| Pexp_constraint (e, _)
|
||||
| Pexp_coerce (e, _, _)
|
||||
| Pexp_letexception (_, e)
|
||||
| Pexp_field (e, _) -> expr e
|
||||
| Pexp_while (e1, e2)
|
||||
| Pexp_sequence (e1, e2)
|
||||
|
@ -2729,6 +2730,16 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
|
|||
exp_type = ty;
|
||||
exp_attributes = sexp.pexp_attributes;
|
||||
exp_env = env }
|
||||
| Pexp_letexception(cd, sbody) ->
|
||||
let (cd, newenv) = Typedecl.transl_exception env cd in
|
||||
let body = type_expect newenv sbody ty_expected in
|
||||
re {
|
||||
exp_desc = Texp_letexception(cd, body);
|
||||
exp_loc = loc; exp_extra = [];
|
||||
exp_type = body.exp_type;
|
||||
exp_attributes = sexp.pexp_attributes;
|
||||
exp_env = env }
|
||||
|
||||
| Pexp_assert (e) ->
|
||||
let cond = type_expect env e Predef.type_bool in
|
||||
let exp_type =
|
||||
|
|
|
@ -103,6 +103,7 @@ and expression_desc =
|
|||
| Texp_setinstvar of Path.t * Path.t * string loc * expression
|
||||
| Texp_override of Path.t * (Path.t * string loc * expression) list
|
||||
| Texp_letmodule of Ident.t * string loc * module_expr * expression
|
||||
| Texp_letexception of extension_constructor * expression
|
||||
| Texp_assert of expression
|
||||
| Texp_lazy of expression
|
||||
| Texp_object of class_structure * string list
|
||||
|
|
|
@ -204,6 +204,7 @@ and expression_desc =
|
|||
| Texp_setinstvar of Path.t * Path.t * string loc * expression
|
||||
| Texp_override of Path.t * (Path.t * string loc * expression) list
|
||||
| Texp_letmodule of Ident.t * string loc * module_expr * expression
|
||||
| Texp_letexception of extension_constructor * expression
|
||||
| Texp_assert of expression
|
||||
| Texp_lazy of expression
|
||||
| Texp_object of class_structure * string list
|
||||
|
|
|
@ -342,6 +342,9 @@ module MakeIterator(Iter : IteratorArgument) : sig
|
|||
| Texp_letmodule (id, _, mexpr, exp) ->
|
||||
iter_module_expr mexpr;
|
||||
iter_expression exp
|
||||
| Texp_letexception (cd, exp) ->
|
||||
iter_extension_constructor cd;
|
||||
iter_expression exp
|
||||
| Texp_assert exp -> iter_expression exp
|
||||
| Texp_lazy exp -> iter_expression exp
|
||||
| Texp_object (cl, _) ->
|
||||
|
|
|
@ -371,6 +371,11 @@ module MakeMap(Map : MapArgument) = struct
|
|||
map_module_expr mexpr,
|
||||
map_expression exp
|
||||
)
|
||||
| Texp_letexception (cd, exp) ->
|
||||
Texp_letexception (
|
||||
map_extension_constructor cd,
|
||||
map_expression exp
|
||||
)
|
||||
| Texp_assert exp -> Texp_assert (map_expression exp)
|
||||
| Texp_lazy exp -> Texp_lazy (map_expression exp)
|
||||
| Texp_object (cl, string_list) ->
|
||||
|
|
|
@ -450,6 +450,9 @@ let expression sub exp =
|
|||
| Texp_letmodule (_id, name, mexpr, exp) ->
|
||||
Pexp_letmodule (name, sub.module_expr sub mexpr,
|
||||
sub.expr sub exp)
|
||||
| Texp_letexception (ext, exp) ->
|
||||
Pexp_letexception (sub.extension_constructor sub ext,
|
||||
sub.expr sub exp)
|
||||
| Texp_assert exp -> Pexp_assert (sub.expr sub exp)
|
||||
| Texp_lazy exp -> Pexp_lazy (sub.expr sub exp)
|
||||
| Texp_object (cl, _) ->
|
||||
|
|
Loading…
Reference in New Issue