Skip to content

Commit

Permalink
remove Const flag (closes HaxeFoundation#3192)
Browse files Browse the repository at this point in the history
  • Loading branch information
Simn committed Feb 20, 2016
1 parent d35b3f1 commit 90c821d
Show file tree
Hide file tree
Showing 8 changed files with 34 additions and 55 deletions.
2 changes: 1 addition & 1 deletion interp.ml
Original file line number Diff line number Diff line change
Expand Up @@ -4578,7 +4578,7 @@ and encode_anon_status s =
let tag, pl = (match s with
| Closed -> 0, []
| Opened -> 1, []
| Type.Const -> 2, []
(* | Type.Const -> 2, [] *)
| Extend tl -> 3, [encode_ref tl (fun tl -> enc_array (List.map encode_type tl)) (fun() -> "<extended types>")]
| Statics cl -> 4, [encode_clref cl]
| EnumStatics en -> 5, [encode_enref en]
Expand Down
8 changes: 0 additions & 8 deletions optimizer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -515,14 +515,6 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
l.i_write <- true;
let e2 = map false e2 in
{e with eexpr = TBinop(op,{e1 with eexpr = TLocal l.i_subst},e2)}
| TObjectDecl fl ->
let fl = List.map (fun (s,e) -> s,map false e) fl in
begin match follow e.etype with
| TAnon an when (match !(an.a_status) with Const -> true | _ -> false) ->
{e with eexpr = TObjectDecl fl; etype = TAnon { an with a_status = ref Closed}}
| _ ->
{e with eexpr = TObjectDecl fl}
end
| TFunction f ->
(match f.tf_args with [] -> () | _ -> has_vars := true);
let old = save_locals ctx and old_fun = !in_local_fun in
Expand Down
5 changes: 5 additions & 0 deletions tests/misc/projects/Issue3192/Main1.hx
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
class Main {
static function main() {
var a:{a:Int} = { a: 1, b: 2 };
}
}
2 changes: 2 additions & 0 deletions tests/misc/projects/Issue3192/compile1-fail.hxml
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
-main Main1
--interp
1 change: 1 addition & 0 deletions tests/misc/projects/Issue3192/compile1-fail.hxml.stderr
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Main1.hx:3: characters 18-32 : { b : Int, a : Int } has extra field b
17 changes: 17 additions & 0 deletions tests/unit/src/unit/issues/Issue3192.hx
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
package unit.issues;

class Issue3192 extends Test {
function test() {
var x1 = {x:1, y:2};
var x2 = ({x:1, y:2}:{x:Int,y:Int});
var x3:{x:Int,y:Int} = {x:1, y:2};
var y1:{} = x1;
var y2:{} = x2;
var y3:{} = x3;
var z1:{x:Int} = x1;
var z2:{x:Int} = x2;
var z3:{x:Int} = x3;
eq(1, x1.x);
eq(2, x1.y);
}
}
12 changes: 4 additions & 8 deletions type.ml
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,6 @@ and tfunc = {
and anon_status =
| Closed
| Opened
| Const
| Extend of t list
| Statics of tclass
| EnumStatics of tenum
Expand Down Expand Up @@ -1707,7 +1706,7 @@ let rec unify a b =
(match !(an.a_status) with
| Opened -> an.a_status := Closed;
| Statics _ | EnumStatics _ | AbstractStatics _ -> error []
| Closed | Extend _ | Const -> ())
| Closed | Extend _ -> ())
with
Unify_error l -> error (cannot_unify a b :: l))
| TAnon a1, TAnon a2 ->
Expand Down Expand Up @@ -1831,14 +1830,11 @@ and unify_anons a b a1 a2 =
| Opened ->
if not (link (ref None) a f2.cf_type) then error [];
a1.a_fields <- PMap.add n f2 a1.a_fields
| Const when Meta.has Meta.Optional f2.cf_meta ->
()
| _ ->
error [has_no_field a n];
if not (Meta.has Meta.Optional f2.cf_meta) then
error [has_no_field a n];
) a2.a_fields;
(match !(a1.a_status) with
| Const when not (PMap.is_empty a2.a_fields) ->
PMap.iter (fun n _ -> if not (PMap.mem n a2.a_fields) then error [has_extra_field a n]) a1.a_fields;
| Opened ->
a1.a_status := Closed
| _ -> ());
Expand All @@ -1847,7 +1843,7 @@ and unify_anons a b a1 a2 =
| EnumStatics e -> (match !(a1.a_status) with EnumStatics e2 when e == e2 -> () | _ -> error [])
| AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error [])
| Opened -> a2.a_status := Closed
| Const | Extend _ | Closed -> ())
| Extend _ | Closed -> ())
with
Unify_error l -> error (cannot_unify a b :: l))

Expand Down
42 changes: 4 additions & 38 deletions typer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -152,34 +152,6 @@ let get_abstract_froms a pl =
acc
) l a.a_from_field

(*
temporally remove the constant flag from structures to allow larger unification
*)
let remove_constant_flag t callb =
let tmp = ref [] in
let rec loop t =
match follow t with
| TAnon a ->
if !(a.a_status) = Const then begin
a.a_status := Closed;
tmp := a :: !tmp;
end;
PMap.iter (fun _ f -> loop f.cf_type) a.a_fields;
| _ ->
()
in
let restore() =
List.iter (fun a -> a.a_status := Const) (!tmp)
in
try
loop t;
let ret = callb (!tmp <> []) in
restore();
ret
with e ->
restore();
raise e

let rec is_pos_infos = function
| TMono r ->
(match !r with
Expand Down Expand Up @@ -626,7 +598,7 @@ let rec unify_min_raise ctx (el:texpr list) : t =
let expr f = match f.cf_expr with None -> mk (TBlock []) f.cf_type f.cf_pos | Some e -> e in
let fields = List.fold_left (fun acc e ->
match follow e.etype with
| TAnon a when !(a.a_status) = Const ->
| TAnon a ->
if !fcount = -1 then begin
fcount := field_count a;
PMap.map (fun f -> [expr f]) a.a_fields
Expand Down Expand Up @@ -1275,7 +1247,6 @@ let rec using_field ctx mode e i p =
| TMono _ -> raise Not_found
| t -> t == t_dynamic
in
let check_constant_struct = ref false in
let rec loop = function
| [] ->
raise Not_found
Expand Down Expand Up @@ -1304,7 +1275,6 @@ let rec using_field ctx mode e i p =
with Not_found ->
loop l
| Unify_error el | Error (Unify el,_) ->
if List.exists (function Has_extra_field _ -> true | _ -> false) el then check_constant_struct := true;
loop l
in
try loop ctx.m.module_using with Not_found ->
Expand All @@ -1315,8 +1285,7 @@ let rec using_field ctx mode e i p =
| _ -> assert false);
acc
with Not_found ->
if not !check_constant_struct then raise Not_found;
remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found)
raise Not_found

let rec type_ident_raise ctx i p mode =
match i with
Expand Down Expand Up @@ -3080,7 +3049,7 @@ and type_object_decl ctx fl with_type p =
let e = if is_quoted then wrap_quoted_meta e else e in
(n,e)
) fl in
let t = (TAnon { a_fields = !fields; a_status = ref Const }) in
let t = (TAnon { a_fields = !fields; a_status = ref Closed }) in
if not ctx.untyped then begin
(match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) field_map [] with
| [] -> ()
Expand All @@ -3107,12 +3076,9 @@ and type_object_decl ctx fl with_type p =
end else acc)
in
let fields , types = List.fold_left loop ([],PMap.empty) fl in
let x = ref Const in
ctx.opened <- x :: ctx.opened;
mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = ref Closed }) p
| ODKWithStructure a ->
let t, fl = type_fields a.a_fields in
if !(a.a_status) <> Const then a.a_status := Closed;
mk (TObjectDecl fl) t p
| ODKWithClass (c,tl) ->
let _,ctor = get_constructor ctx c tl p in
Expand Down

0 comments on commit 90c821d

Please sign in to comment.