|
@@ -6,6 +6,29 @@ open TyperBase
|
|
|
open Error
|
|
|
open Typecore
|
|
|
|
|
|
+module TypeFieldConfig = struct
|
|
|
+ type t = {
|
|
|
+ allow_resolve : bool;
|
|
|
+ do_resume : bool;
|
|
|
+ }
|
|
|
+
|
|
|
+ let allow_resolve cfg = cfg.allow_resolve
|
|
|
+
|
|
|
+ let do_resume cfg = cfg.do_resume
|
|
|
+
|
|
|
+ let default = {
|
|
|
+ allow_resolve = true;
|
|
|
+ do_resume = false;
|
|
|
+ }
|
|
|
+
|
|
|
+ let create resume = {
|
|
|
+ allow_resolve = true;
|
|
|
+ do_resume = resume;
|
|
|
+ }
|
|
|
+
|
|
|
+ let with_resume cfg = {cfg with do_resume = true}
|
|
|
+end
|
|
|
+
|
|
|
(*
|
|
|
temporally remove the constant flag from structures to allow larger unification
|
|
|
*)
|
|
@@ -292,9 +315,9 @@ let rec using_field ctx mode e i p =
|
|
|
remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found)
|
|
|
|
|
|
(* Resolves field [i] on typed expression [e] using the given [mode]. *)
|
|
|
-let rec type_field ?(resume=false) ctx e i p mode =
|
|
|
+let rec type_field cfg ctx e i p mode =
|
|
|
let no_field() =
|
|
|
- if resume then raise Not_found;
|
|
|
+ if TypeFieldConfig.do_resume cfg then raise Not_found;
|
|
|
let t = match follow e.etype with
|
|
|
| TAnon a -> (match !(a.a_status) with
|
|
|
| Statics {cl_kind = KAbstractImpl a} -> TAbstract(a,[])
|
|
@@ -393,7 +416,7 @@ let rec type_field ?(resume=false) ctx e i p mode =
|
|
|
begin match follow t with
|
|
|
| TAbstract({a_impl = Some c},tl) when PMap.mem i c.cl_statics ->
|
|
|
let e = mk_cast e t p in
|
|
|
- type_field ctx e i p mode;
|
|
|
+ type_field cfg ctx e i p mode;
|
|
|
| _ ->
|
|
|
loop tl
|
|
|
end
|
|
@@ -442,7 +465,7 @@ let rec type_field ?(resume=false) ctx e i p mode =
|
|
|
| Statics {cl_kind = KAbstractImpl a} when does_forward a true ->
|
|
|
let mt = try module_type_of_type a.a_this with Exit -> raise Not_found in
|
|
|
let et = type_module_type ctx mt None p in
|
|
|
- type_field ctx et i p mode;
|
|
|
+ type_field cfg ctx et i p mode;
|
|
|
| _ ->
|
|
|
raise Not_found
|
|
|
with Not_found ->
|
|
@@ -524,14 +547,14 @@ let rec type_field ?(resume=false) ctx e i p mode =
|
|
|
error "This operation is unsupported" p)
|
|
|
with Not_found -> try
|
|
|
if does_forward a false then
|
|
|
- type_field ~resume:true ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode
|
|
|
+ type_field (TypeFieldConfig.with_resume cfg) ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode
|
|
|
else
|
|
|
raise Not_found
|
|
|
with Not_found -> try
|
|
|
using_field ctx mode e i p
|
|
|
with Not_found -> try
|
|
|
(match ctx.curfun, e.eexpr with
|
|
|
- | FunMemberAbstract, TConst (TThis) -> type_field ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode;
|
|
|
+ | FunMemberAbstract, TConst (TThis) -> type_field cfg ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode;
|
|
|
| _ -> raise Not_found)
|
|
|
with Not_found -> try
|
|
|
let get_resolve is_write =
|
|
@@ -551,9 +574,12 @@ let rec type_field ?(resume=false) ctx e i p mode =
|
|
|
else
|
|
|
AKExpr ((!build_call_ref) ctx (AKUsing(ef,c,cf,e,false)) [EConst (String i),p] NoValue p)
|
|
|
in
|
|
|
+ if not (TypeFieldConfig.allow_resolve cfg) then raise Not_found;
|
|
|
get_resolve (mode = MSet)
|
|
|
with Not_found ->
|
|
|
if !static_abstract_access_through_instance then error ("Invalid call to static function " ^ i ^ " through abstract instance") p
|
|
|
else no_field())
|
|
|
| _ ->
|
|
|
try using_field ctx mode e i p with Not_found -> no_field()
|
|
|
+
|
|
|
+let type_field_default_cfg = type_field TypeFieldConfig.default
|