[eval] put objects in dictionary mode upon unknown access

see #10284

src/macro/eval/evalContext.ml

@@ -353,10 +353,13 @@ let rec kind_name eval kind =
 
 let call_function f vl = f vl
 
-let object_fields o =
-	IntMap.fold (fun key index acc ->
-		(key,(o.ofields.(index))) :: acc
-	) o.oproto.pinstance_names []
+let object_fields o = match o.oproto with
+	| OProto proto ->
+		IntMap.fold (fun key index acc ->
+			(key,(o.ofields.(index))) :: acc
+		) proto.pinstance_names []
+	| ODictionary d ->
+		IntMap.fold (fun k v acc -> (k,v) :: acc) d []
 
 let instance_fields i =
 	IntMap.fold (fun name key acc ->

src/macro/eval/evalEmitter.ml

@@ -107,7 +107,7 @@ let emit_object_declaration proto fa env =
 	Array.iter (fun (i,exec) -> a.(i) <- exec env) fa;
 	vobject {
 		ofields = a;
-		oproto = proto;
+		oproto = OProto proto;
 	}
 
 let emit_array_declaration execs env =
@@ -408,8 +408,12 @@ let emit_field_closure exec name env =
 let emit_anon_field_read exec proto i name p env =
 	match vresolve (exec env) with
 	| VObject o ->
-		if proto == o.oproto then o.ofields.(i)
-		else object_field o name
+		begin match o.oproto with
+		| OProto proto' when proto' == proto ->
+			o.ofields.(i)
+		| _ ->
+			object_field o name
+		end
 	| VNull -> throw_string "field access on null" p
 	| v -> field v name
 
@@ -481,10 +485,14 @@ let emit_anon_field_write exec1 p proto i name exec2 env =
 	let v2 = exec2 env in
 	begin match vresolve v1 with
 		| VObject o ->
-			if proto == o.oproto then begin
+			begin match o.oproto with
+			| OProto proto' when proto' == proto ->
 				o.ofields.(i) <- v2;
-			end else set_object_field o name v2
-		| VNull -> throw_string "field access on null" p
+			| _ ->
+				set_object_field o name v2
+			end
+		| VNull ->
+			throw_string "field access on null" p
 		| _ ->
 			set_field v1 name v2;
 	end;

src/macro/eval/evalEncode.ml

@@ -141,7 +141,7 @@ let encode_obj l =
 	let proto,sorted = ctx.get_object_prototype ctx l in
 	vobject {
 		ofields = Array.of_list (List.map snd sorted);
-		oproto = proto;
+		oproto = OProto proto;
 	}
 
 let encode_obj_s l =

src/macro/eval/evalField.ml

@@ -37,8 +37,11 @@ let rec proto_field_raise proto name =
 let instance_field vi name =
 	vi.ifields.(get_instance_field_index_raise vi.iproto name)
 
-let object_field_raise o name =
-	o.ofields.(get_instance_field_index_raise o.oproto name)
+let object_field_raise o name = match o.oproto with
+	| OProto proto ->
+		o.ofields.(get_instance_field_index_raise proto name)
+	| ODictionary l ->
+		IntMap.find name l
 
 let object_field o name =
 	try object_field_raise o name with Not_found -> vnull

src/macro/eval/evalMain.ml

@@ -123,7 +123,7 @@ let create com api is_macro =
 		(* eval *)
 		toplevel = 	vobject {
 			ofields = [||];
-			oproto = fake_proto key_eval_toplevel;
+			oproto = OProto (fake_proto key_eval_toplevel);
 		};
 		eval = eval;
 		evals = evals;

src/macro/eval/evalMisc.ml

@@ -39,7 +39,7 @@ let update_object_prototype o fields =
 	let ctx = get_ctx() in
 	let proto,fields = ctx.get_object_prototype (get_ctx()) fields in
 	o.ofields <- Array.of_list (List.map snd fields);
-	o.oproto <- proto
+	o.oproto <- OProto proto
 
 (* Calls *)
 
@@ -59,12 +59,38 @@ let set_instance_field vi name v2 =
 	vi.ifields.(get_instance_field_index_raise vi.iproto name) <- v2
 
 let set_object_field o name v2 =
-	try
-		o.ofields.(get_instance_field_index_raise o.oproto name) <- v2;
-	with Not_found ->
-		let fields = IntMap.fold (fun name i acc -> (name,o.ofields.(i)) :: acc) o.oproto.pinstance_names [] in
-		let fields = (name,v2) :: fields in
-		update_object_prototype o fields
+	match o.oproto with
+	| OProto proto ->
+		begin try
+			o.ofields.(get_instance_field_index_raise proto name) <- v2;
+		with Not_found ->
+			let fields = IntMap.fold (fun name i acc -> (name,o.ofields.(i)) :: acc) proto.pinstance_names [] in
+			let fields = (name,v2) :: fields in
+			update_object_prototype o fields
+		end
+	| ODictionary d ->
+		o.oproto <- ODictionary (IntMap.add name v2 d)
+
+(* Turns prototypes into dictionaries if the field doesn't exist. *)
+let set_object_field_runtime o name v2 =
+	let update_dictionary d =
+		IntMap.add name v2 d
+	in
+	let make_dictionary proto =
+		IntMap.map (fun i -> o.ofields.(i)) proto.pinstance_names
+	in
+	match o.oproto with
+	| OProto proto ->
+		begin try
+			o.ofields.(get_instance_field_index_raise proto name) <- v2;
+		with Not_found ->
+			let d = make_dictionary proto in
+			let d = update_dictionary d in
+			o.oproto <- ODictionary d
+		end
+	| ODictionary d ->
+		let d = update_dictionary d in
+		o.oproto <- ODictionary d
 
 let set_bytes_length_field v1 v2 =
 	match v1 with
@@ -88,6 +114,10 @@ let set_field v1 name v2 = match vresolve v1 with
 	| VInstance vi -> set_instance_field vi name v2
 	| _ -> unexpected_value v1 "object"
 
+let set_field_runtime v1 name v2 = match vresolve v1 with
+	| VObject o -> set_object_field_runtime o name v2
+	| _ -> set_field v1 name v2
+
 (* Equality/compare *)
 
 let fcmp (a:float) b = if a = b then CEq else if a < b then CInf else if a > b then CSup else CUndef

src/macro/eval/evalPrototype.ml

@@ -289,16 +289,19 @@ let create_instance_prototype ctx c =
 
 let get_object_prototype ctx l =
 	let l = List.sort (fun (i1,_) (i2,_) -> if i1 = i2 then 0 else if i1 < i2 then -1 else 1) l in
-	let sfields = String.concat "," (List.map (fun (i,_) -> (Printf.sprintf ":%s" (rev_hash i))) l) in
-	let name = hash (Printf.sprintf "eval.object.Object[%s]" sfields) in
-	try
-		IntMap.find name ctx.instance_prototypes,l
-	with Not_found ->
-		let pctx = PrototypeBuilder.create ctx name None PObject None in
-		List.iter (fun (name,_) -> PrototypeBuilder.add_instance_field pctx name (lazy vnull)) l;
-		let proto = fst (PrototypeBuilder.finalize pctx) in
-		ctx.instance_prototypes <- IntMap.add name proto ctx.instance_prototypes;
-		proto,l
+	let proto =
+		let sfields = String.concat "," (List.map (fun (i,_) -> (Printf.sprintf ":%s" (rev_hash i))) l) in
+		let name = hash (Printf.sprintf "eval.object.Object[%s]" sfields) in
+		try
+			IntMap.find name ctx.instance_prototypes
+		with Not_found ->
+			let pctx = PrototypeBuilder.create ctx name None PObject None in
+			List.iter (fun (name,_) -> PrototypeBuilder.add_instance_field pctx name (lazy vnull)) l;
+			let proto = fst (PrototypeBuilder.finalize pctx) in
+			ctx.instance_prototypes <- IntMap.add name proto ctx.instance_prototypes;
+			proto
+	in
+	proto,l
 
 let add_types ctx types ready =
 	let t = Timer.timer [(if ctx.is_macro then "macro" else "interp");"add_types"] in

src/macro/eval/evalStdLib.ml

@@ -1882,19 +1882,26 @@ module StdReflect = struct
 		let name = hash (decode_vstring name).sstring in
 		match vresolve o with
 		| VObject o ->
-			let found = ref false in
-			let fields = IntMap.fold (fun name' i acc ->
-				if name = name' then begin
-					found := true;
-					acc
+			begin match o.oproto with
+			| OProto proto ->
+				let found = ref false in
+				let fields = IntMap.fold (fun name' i acc ->
+					if name = name' then begin
+						found := true;
+						acc
+					end else
+						(name',o.ofields.(i)) :: acc
+				) proto.pinstance_names [] in
+				if !found then begin
+					update_object_prototype o fields;
+					vtrue
 				end else
-					(name',o.ofields.(i)) :: acc
-			) o.oproto.pinstance_names [] in
-			if !found then begin
-				update_object_prototype o fields;
-				vtrue
-			end else
-				vfalse
+					vfalse
+			| ODictionary d ->
+				let has = IntMap.mem name d in
+				if has then o.oproto <- ODictionary (IntMap.remove name d);
+				vbool has
+			end
 		| _ ->
 			vfalse
 	)
@@ -1931,7 +1938,11 @@ module StdReflect = struct
 	let hasField = vfun2 (fun o field ->
 		let name = hash (decode_vstring field).sstring in
 		let b = match vresolve o with
-			| VObject o -> IntMap.mem name o.oproto.pinstance_names
+			| VObject o ->
+				begin match o.oproto with
+				| OProto proto -> IntMap.mem name proto.pinstance_names
+				| ODictionary d -> IntMap.mem name d
+				end
 			| VInstance vi -> IntMap.mem name vi.iproto.pinstance_names || IntMap.mem name vi.iproto.pnames
 			| VPrototype proto -> IntMap.mem name proto.pnames
 			| _ -> unexpected_value o "object"
@@ -1960,7 +1971,7 @@ module StdReflect = struct
 	)
 
 	let setField = vfun3 (fun o name v ->
-		(try set_field o (hash (decode_vstring name).sstring) v with Not_found -> ()); vnull
+		(try set_field_runtime o (hash (decode_vstring name).sstring) v with Not_found -> ()); vnull
 	)
 
 	let setProperty = vfun3 (fun o name v ->
@@ -1969,7 +1980,7 @@ module StdReflect = struct
 		let vset = field o name_set in
 		if vset <> VNull then call_value_on o vset [v]
 		else begin
-			(try set_field o (hash name.sstring) v with Not_found -> ());
+			(try set_field_runtime o (hash name.sstring) v with Not_found -> ());
 			vnull
 		end
 	)

src/macro/eval/evalValue.ml

@@ -154,9 +154,13 @@ and vobject = {
 	(* The fields of the object known when it is created. *)
 	mutable ofields : value array;
 	(* The prototype of the object. *)
-	mutable oproto : vprototype;
+	mutable oproto : vobject_proto;
 }
 
+and vobject_proto =
+	| OProto of vprototype
+	| ODictionary of value IntMap.t
+
 and vprototype = {
 	(* The path of the prototype. Using rev_hash on this gives the original dot path. *)
 	ppath : int;