Browse Source

introduce implicit texpr type instances

Simon Krajewski 1 year ago
parent
commit
ddaf46cf47
2 changed files with 147 additions and 78 deletions
  1. 81 67
      src/compiler/hxb/hxbReader.ml
  2. 66 11
      src/compiler/hxb/hxbWriter.ml

+ 81 - 67
src/compiler/hxb/hxbReader.ml

@@ -935,39 +935,40 @@ class hxb_reader
 			let loop2 () =
 				match IO.read_byte ch with
 					(* values 0-19 *)
-					| 0 -> TConst TNull
-					| 1 -> TConst TThis
-					| 2 -> TConst TSuper
-					| 3 -> TConst (TBool false)
-					| 4 -> TConst (TBool true)
-					| 5 -> TConst (TInt self#read_i32)
-					| 6 -> TConst (TFloat self#read_string)
-					| 7 -> TConst (TString self#read_string)
+					| 0 -> TConst TNull,None
+					| 1 -> TConst TThis,fctx.tthis
+					| 2 -> TConst TSuper,None
+					| 3 -> TConst (TBool false),(Some api#basic_types.tbool)
+					| 4 -> TConst (TBool true),(Some api#basic_types.tbool)
+					| 5 -> TConst (TInt self#read_i32),(Some api#basic_types.tint)
+					| 6 -> TConst (TFloat self#read_string),(Some api#basic_types.tfloat)
+					| 7 -> TConst (TString self#read_string),(Some api#basic_types.tstring)
 
 					(* vars 20-29 *)
 					| 20 ->
-						TLocal (fctx.vars.(read_uleb128 ch))
+						TLocal (fctx.vars.(read_uleb128 ch)),None
 					| 21 ->
 						let v = declare_local () in
-						TVar (v,None)
+						TVar (v,None),(Some api#basic_types.tvoid)
 					| 22 ->
-							let v = declare_local () in
-							let e = loop () in
-							TVar (v, Some e)
+						let v = declare_local () in
+						let e = loop () in
+						TVar (v, Some e),(Some api#basic_types.tvoid)
 
 					(* blocks 30-49 *)
-					| 30 -> TBlock []
+					| 30 ->
+						TBlock [],None
 					| 31 | 32 | 33 | 34 | 35 as i ->
 						let l = i - 30 in
 						let el = List.init l (fun _ -> loop ()) in
-						TBlock el;
+						TBlock el,None
 					| 36 ->
 						let l = IO.read_byte ch in
 						let el = List.init l (fun _ -> loop ()) in
-						TBlock el;
+						TBlock el,None
 					| 39 ->
 						let el = self#read_list loop in
-						TBlock el;
+						TBlock el,None
 
 					(* function 50-59 *)
 					| 50 ->
@@ -983,16 +984,17 @@ class hxb_reader
 							tf_args = args;
 							tf_type = r;
 							tf_expr = e;
-						}
+						},None
 					(* texpr compounds 60-79 *)
 					| 60 ->
 						let e1 = loop () in
 						let e2 = loop () in
-						TArray (e1,e2)
+						TArray (e1,e2),None
 					| 61 ->
-						TParenthesis (loop ())
+						let e = loop () in
+						TParenthesis e,Some e.etype
 					| 62 ->
-						TArrayDecl (loop_el())
+						TArrayDecl (loop_el()),None
 					| 63 ->
 						let fl = self#read_list (fun () ->
 							let name = self#read_string in
@@ -1005,39 +1007,35 @@ class hxb_reader
 							let e = loop () in
 							((name,p,qs),e)
 						) in
-						TObjectDecl fl
-					| 64 ->
-						let e1 = loop () in
-						let el = loop_el() in
-						TCall(e1,el)
+						TObjectDecl fl,None
 					| 65 ->
 						let m = self#read_metadata_entry in
 						let e1 = loop () in
-						TMeta (m,e1)
+						TMeta (m,e1),(Some e1.etype)
 
 					(* calls 70 - 79 *)
 					| 70 ->
 						let e1 = loop () in
-						TCall(e1,[])
+						TCall(e1,[]),None
 					| 71 | 72 | 73 | 74 as i ->
 						let e1 = loop () in
 						let el = List.init (i - 70) (fun _ -> loop ()) in
-						TCall(e1,el)
+						TCall(e1,el),None
 					| 79 ->
 						let e1 = loop () in
 						let el = self#read_list loop in
-						TCall(e1,el)
+						TCall(e1,el),None
 
 					(* branching 80-89 *)
 					| 80 ->
 						let e1 = loop () in
 						let e2 = loop () in
-						TIf(e1,e2,None)
+						TIf(e1,e2,None),(Some api#basic_types.tvoid)
 					| 81 ->
 						let e1 = loop () in
 						let e2 = loop () in
 						let e3 = loop () in
-						TIf(e1,e2,Some e3)
+						TIf(e1,e2,Some e3),None
 					| 82 ->
 						let subject = loop () in
 						let cases = self#read_list (fun () ->
@@ -1051,7 +1049,7 @@ class hxb_reader
 							switch_cases = cases;
 							switch_default = def;
 							switch_exhaustive = true;
-						}
+						},None
 					| 83 ->
 						let e1 = loop () in
 						let catches = self#read_list (fun () ->
@@ -1059,130 +1057,146 @@ class hxb_reader
 							let e = loop () in
 							(v,e)
 						) in
-						TTry(e1,catches)
+						TTry(e1,catches),None
 					| 84 ->
 						let e1 = loop () in
 						let e2 = loop () in
-						TWhile(e1,e2,NormalWhile)
+						TWhile(e1,e2,NormalWhile),(Some api#basic_types.tvoid)
 					| 85 ->
 						let e1 = loop () in
 						let e2 = loop () in
-						TWhile(e1,e2,DoWhile)
+						TWhile(e1,e2,DoWhile),(Some api#basic_types.tvoid)
 					| 86 ->
 						let v  = declare_local () in
 						let e1 = loop () in
 						let e2 = loop () in
-						TFor(v,e1,e2)
+						TFor(v,e1,e2),(Some api#basic_types.tvoid)
 
 					(* control flow 90-99 *)
-					| 90 -> TReturn None
-					| 91 -> TReturn (Some (loop ()))
-					| 92 -> TContinue
-					| 93 -> TBreak
-					| 94 -> TThrow (loop ())
+					| 90 ->
+						TReturn None,(Some t_dynamic)
+					| 91 ->
+						TReturn (Some (loop ())),(Some t_dynamic)
+					| 92 ->
+						TContinue,(Some t_dynamic)
+					| 93 ->
+						TBreak,(Some t_dynamic)
+					| 94 ->
+						TThrow (loop ()),(Some t_dynamic)
 
 					(* access 100-119 *)
-					| 100 -> TEnumIndex (loop ())
+					| 100 ->
+						TEnumIndex (loop ()),(Some api#basic_types.tint)
 					| 101 ->
 						let e1 = loop () in
 						let ef = self#read_enum_field_ref in
 						let i = read_uleb128 ch in
-						TEnumParameter(e1,ef,i)
+						TEnumParameter(e1,ef,i),None
 					| 102 ->
 						let e1 = loop () in
 						let c = self#read_class_ref in
 						let tl = self#read_types in
 						let cf = self#read_field_ref in
-						TField(e1,FInstance(c,tl,cf))
+						TField(e1,FInstance(c,tl,cf)),None
 					| 103 ->
 						let e1 = loop () in
 						let c = self#read_class_ref in
 						let cf = self#read_field_ref in
-						TField(e1,FStatic(c,cf))
+						TField(e1,FStatic(c,cf)),None
 					| 104 ->
 						let e1 = loop () in
 						let cf = self#read_anon_field_ref in
-						TField(e1,FAnon(cf))
+						TField(e1,FAnon(cf)),None
 					| 105 ->
 						let e1 = loop () in
 						let c = self#read_class_ref in
 						let tl = self#read_types in
 						let cf = self#read_field_ref in
-						TField(e1,FClosure(Some(c,tl),cf))
+						TField(e1,FClosure(Some(c,tl),cf)),None
 					| 106 ->
 						let e1 = loop () in
 						let cf = self#read_anon_field_ref in
-						TField(e1,FClosure(None,cf))
+						TField(e1,FClosure(None,cf)),None
 					| 107 ->
 						let e1 = loop () in
 						let en = self#read_enum_ref in
 						let ef = self#read_enum_field_ref in
-						TField(e1,FEnum(en,ef))
+						TField(e1,FEnum(en,ef)),None
 					| 108 ->
 						let e1 = loop () in
 						let s = self#read_string in
-						TField(e1,FDynamic s)
+						TField(e1,FDynamic s),None
 
 					| 110 ->
 						let p = read_relpos () in
 						let c = self#read_class_ref in
 						let cf = self#read_field_ref in
 						let e1 = Texpr.Builder.make_static_this c p in
-						TField(e1,FStatic(c,cf))
+						TField(e1,FStatic(c,cf)),None
 					| 111 ->
 						let p = read_relpos () in
 						let c = self#read_class_ref in
 						let tl = self#read_types in
 						let cf = self#read_field_ref in
 						let ethis = mk (TConst TThis) (Option.get fctx.tthis) p in
-						TField(ethis,FInstance(c,tl,cf))
+						TField(ethis,FInstance(c,tl,cf)),None
 
 					(* module types 120-139 *)
-					| 120 -> TTypeExpr (TClassDecl self#read_class_ref)
-					| 121 -> TTypeExpr (TEnumDecl self#read_enum_ref)
-					| 122 -> TTypeExpr (TAbstractDecl self#read_abstract_ref)
-					| 123 -> TTypeExpr (TTypeDecl self#read_typedef_ref)
-					| 124 -> TCast(loop (),None)
+					| 120 ->
+						let c = self#read_class_ref in
+						TTypeExpr (TClassDecl c),(Some c.cl_type)
+					| 121 ->
+						let en = self#read_enum_ref in
+						TTypeExpr (TEnumDecl en),(Some en.e_type)
+					| 122 ->
+						TTypeExpr (TAbstractDecl self#read_abstract_ref),None
+					| 123 ->
+						TTypeExpr (TTypeDecl self#read_typedef_ref),None
+					| 124 ->
+						TCast(loop (),None),None
 					| 125 ->
 						let e1 = loop () in
 						let (pack,mname,tname) = self#read_full_path in
 						let mt = self#resolve_type pack mname tname in
-						TCast(e1,Some mt)
+						TCast(e1,Some mt),None
 					| 126 ->
 						let c = self#read_class_ref in
 						let tl = self#read_types in
 						let el = loop_el() in
-						TNew(c,tl,el)
+						TNew(c,tl,el),None
 					| 127 ->
 						let ttp = self#resolve_ttp_ref (read_uleb128 ch) in
 						let tl = self#read_types in
 						let el = loop_el() in
-						TNew(ttp.ttp_class,tl,el)
+						TNew(ttp.ttp_class,tl,el),None
 					| 128 ->
 						let ttp = self#resolve_ttp_ref (read_uleb128 ch) in
-						TTypeExpr (TClassDecl ttp.ttp_class)
+						TTypeExpr (TClassDecl ttp.ttp_class),None
 
 					(* unops 140-159 *)
 					| i when i >= 140 && i < 160 ->
 						let (op,flag) = self#get_unop (i - 140) in
 						let e = loop () in
-						TUnop(op,flag,e)
+						TUnop(op,flag,e),None
 
 					(* binops 160-219 *)
 					| i when i >= 160 && i < 220 ->
 						let op = self#get_binop (i - 160) in
 						let e1 = loop () in
 						let e2 = loop () in
-						TBinop(op,e1,e2)
+						TBinop(op,e1,e2),None
 					(* rest 250-254 *)
 					| 250 ->
-						TIdent (self#read_string)
+						TIdent (self#read_string),None
 
 					| i ->
 						die (Printf.sprintf "  [ERROR] Unhandled texpr %d at:" i) __LOC__
 				in
-				let e = loop2 () in
-				let t = fctx.t_pool.(read_uleb128 ch) in
+				let e,t = loop2 () in
+				let t = match t with
+					| None -> fctx.t_pool.(read_uleb128 ch)
+					| Some t -> t
+				in
 				let p = read_relpos () in
 				let e = {
 					eexpr = e;

+ 66 - 11
src/compiler/hxb/hxbWriter.ml

@@ -1291,45 +1291,57 @@ module HxbWriter = struct
 			write_type_instance writer v.v_type;
 		in
 		let rec loop e =
-			begin match e.eexpr with
+			let write_type = match e.eexpr with
 			(* values 0-19 *)
 			| TConst ct ->
 				begin match ct with
 				| TNull ->
 					Chunk.write_u8 writer.chunk 0;
+					true
 				| TThis ->
 					fctx.texpr_this <- Some e;
 					Chunk.write_u8 writer.chunk 1;
+					false;
 				| TSuper ->
 					Chunk.write_u8 writer.chunk 2;
+					true; (* TODO: ? *)
 				| TBool false ->
 					Chunk.write_u8 writer.chunk 3;
+					false;
 				| TBool true ->
 					Chunk.write_u8 writer.chunk 4;
+					false;
 				| TInt i32 ->
 					Chunk.write_u8 writer.chunk 5;
 					Chunk.write_i32 writer.chunk i32;
+					false;
 				| TFloat f ->
 					Chunk.write_u8 writer.chunk 6;
 					Chunk.write_string writer.chunk f;
+					false;
 				| TString s ->
 					Chunk.write_u8 writer.chunk 7;
-					Chunk.write_string writer.chunk s
+					Chunk.write_string writer.chunk s;
+					false
 				end
 			(* vars 20-29 *)
 			| TLocal v ->
 				Chunk.write_u8 writer.chunk 20;
 				Chunk.write_uleb128 writer.chunk v.v_id;
+				true; (* I think there are cases where v_type != etype *)
 			| TVar(v,None) ->
 				Chunk.write_u8 writer.chunk 21;
 				declare_var v;
+				false;
 			| TVar(v,Some e1) ->
 				Chunk.write_u8 writer.chunk 22;
 				declare_var v;
 				loop e1;
+				false;
 			(* blocks 30-49 *)
 			| TBlock [] ->
 				Chunk.write_u8 writer.chunk 30;
+				true;
 			| TBlock el ->
 				let restore = start_temporary_chunk writer 256 in
 				let i = ref 0 in
@@ -1355,6 +1367,7 @@ module HxbWriter = struct
 					end;
 				end;
 				Chunk.write_bytes writer.chunk bytes;
+				true;
 			(* function 50-59 *)
 			| TFunction tf ->
 				Chunk.write_u8 writer.chunk 50;
@@ -1364,17 +1377,21 @@ module HxbWriter = struct
 				);
 				write_type_instance writer tf.tf_type;
 				loop tf.tf_expr;
+				true;
 			(* texpr compounds 60-79 *)
 			| TArray(e1,e2) ->
 				Chunk.write_u8 writer.chunk 60;
 				loop e1;
 				loop e2;
+				true;
 			| TParenthesis e1 ->
 				Chunk.write_u8 writer.chunk 61;
 				loop e1;
+				false; (* surely this is always the nested type *)
 			| TArrayDecl el ->
 				Chunk.write_u8 writer.chunk 62;
 				loop_el el;
+				true;
 			| TObjectDecl fl ->
 				Chunk.write_u8 writer.chunk 63;
 				Chunk.write_list writer.chunk fl (fun ((name,p,qs),e) ->
@@ -1386,22 +1403,27 @@ module HxbWriter = struct
 					end;
 					loop e
 				);
+				true;
 			| TCall(e1,el) ->
-				write_inlined_list writer 70 4 (Chunk.write_u8 writer.chunk) (fun () -> loop e1) loop el
+				write_inlined_list writer 70 4 (Chunk.write_u8 writer.chunk) (fun () -> loop e1) loop el;
+				true;
 			| TMeta(m,e1) ->
 				Chunk.write_u8 writer.chunk 65;
 				write_metadata_entry writer m;
 				loop e1;
+				false;
 			(* branching 80-89 *)
 			| TIf(e1,e2,None) ->
 				Chunk.write_u8 writer.chunk 80;
 				loop e1;
 				loop e2;
+				false;
 			| TIf(e1,e2,Some e3) ->
 				Chunk.write_u8 writer.chunk 81;
 				loop e1;
 				loop e2;
 				loop e3;
+				true;
 			| TSwitch s ->
 				Chunk.write_u8 writer.chunk 82;
 				loop s.switch_subject;
@@ -1410,6 +1432,7 @@ module HxbWriter = struct
 					loop c.case_expr;
 				);
 				Chunk.write_option writer.chunk s.switch_default loop;
+				true;
 			| TTry(e1,catches) ->
 				Chunk.write_u8 writer.chunk 83;
 				loop e1;
@@ -1417,32 +1440,41 @@ module HxbWriter = struct
 					declare_var v;
 					loop e
 				);
+				true;
 			| TWhile(e1,e2,flag) ->
 				Chunk.write_u8 writer.chunk (if flag = NormalWhile then 84 else 85);
 				loop e1;
 				loop e2;
+				false;
 			| TFor(v,e1,e2) ->
 				Chunk.write_u8 writer.chunk 86;
 				declare_var v;
 				loop e1;
 				loop e2;
+				false;
 			(* control flow 90-99 *)
 			| TReturn None ->
 				Chunk.write_u8 writer.chunk 90;
+				false;
 			| TReturn (Some e1) ->
 				Chunk.write_u8 writer.chunk 91;
 				loop e1;
+				false;
 			| TContinue ->
 				Chunk.write_u8 writer.chunk 92;
+				false;
 			| TBreak ->
 				Chunk.write_u8 writer.chunk 93;
+				false;
 			| TThrow e1 ->
 				Chunk.write_u8 writer.chunk 94;
 				loop e1;
+				false;
 			(* access 100-119 *)
 			| TEnumIndex e1 ->
 				Chunk.write_u8 writer.chunk 100;
 				loop e1;
+				false;
 			| TEnumParameter(e1,ef,i) ->
 				Chunk.write_u8 writer.chunk 101;
 				loop e1;
@@ -1457,101 +1489,124 @@ module HxbWriter = struct
 				in
 				write_enum_field_ref writer en ef;
 				Chunk.write_uleb128 writer.chunk i;
+				true;
 			| TField({eexpr = TConst TThis; epos = p1},FInstance(c,tl,cf)) when fctx.texpr_this <> None ->
 				Chunk.write_u8 writer.chunk 111;
 				PosWriter.write_pos fctx.pos_writer writer.chunk true 0 p1;
 				write_class_ref writer c;
 				write_types writer tl;
 				write_field_ref writer c CfrMember cf;
+				true;
 			| TField(e1,FInstance(c,tl,cf)) ->
 				Chunk.write_u8 writer.chunk 102;
 				loop e1;
 				write_class_ref writer c;
 				write_types writer tl;
 				write_field_ref writer c CfrMember cf;
+				true;
 			| TField({eexpr = TTypeExpr (TClassDecl c'); epos = p1},FStatic(c,cf)) when c == c' ->
 				Chunk.write_u8 writer.chunk 110;
 				PosWriter.write_pos fctx.pos_writer writer.chunk true 0 p1;
 				write_class_ref writer c;
 				write_field_ref writer c CfrStatic cf;
+				true;
 			| TField(e1,FStatic(c,cf)) ->
 				Chunk.write_u8 writer.chunk 103;
 				loop e1;
 				write_class_ref writer c;
 				write_field_ref writer c CfrStatic cf;
+				true;
 			| TField(e1,FAnon cf) ->
 				Chunk.write_u8 writer.chunk 104;
 				loop e1;
-				write_anon_field_ref writer cf
+				write_anon_field_ref writer cf;
+				true;
 			| TField(e1,FClosure(Some(c,tl),cf)) ->
 				Chunk.write_u8 writer.chunk 105;
 				loop e1;
 				write_class_ref writer c;
 				write_types writer tl;
-				write_field_ref writer c CfrMember cf
+				write_field_ref writer c CfrMember cf;
+				true;
 			| TField(e1,FClosure(None,cf)) ->
 				Chunk.write_u8 writer.chunk 106;
 				loop e1;
-				write_anon_field_ref writer cf
+				write_anon_field_ref writer cf;
+				true;
 			| TField(e1,FEnum(en,ef)) ->
 				Chunk.write_u8 writer.chunk 107;
 				loop e1;
 				write_enum_ref writer en;
 				write_enum_field_ref writer en ef;
+				true;
 			| TField(e1,FDynamic s) ->
 				Chunk.write_u8 writer.chunk 108;
 				loop e1;
 				Chunk.write_string writer.chunk s;
+				true;
 			(* module types 120-139 *)
 			| TTypeExpr (TClassDecl ({cl_kind = KTypeParameter ttp})) ->
 				Chunk.write_u8 writer.chunk 128;
-				write_type_parameter_ref writer ttp
+				write_type_parameter_ref writer ttp;
+				true;
 			| TTypeExpr (TClassDecl c) ->
 				Chunk.write_u8 writer.chunk 120;
 				write_class_ref writer c;
+				false;
 			| TTypeExpr (TEnumDecl en) ->
 				Chunk.write_u8 writer.chunk 121;
 				write_enum_ref writer en;
+				false;
 			| TTypeExpr (TAbstractDecl a) ->
 				Chunk.write_u8 writer.chunk 122;
-				write_abstract_ref writer a
+				write_abstract_ref writer a;
+				true;
 			| TTypeExpr (TTypeDecl td) ->
 				Chunk.write_u8 writer.chunk 123;
-				write_typedef_ref writer td
+				write_typedef_ref writer td;
+				true;
 			| TCast(e1,None) ->
 				Chunk.write_u8 writer.chunk 124;
 				loop e1;
+				true;
 			| TCast(e1,Some md) ->
 				Chunk.write_u8 writer.chunk 125;
 				loop e1;
 				let infos = t_infos md in
 				let m = infos.mt_module in
 				write_full_path writer (fst m.m_path) (snd m.m_path) (snd infos.mt_path);
+				true;
 			| TNew(({cl_kind = KTypeParameter ttp}),tl,el) ->
 				Chunk.write_u8 writer.chunk 127;
 				write_type_parameter_ref writer ttp;
 				write_types writer tl;
 				loop_el el;
+				true;
 			| TNew(c,tl,el) ->
 				Chunk.write_u8 writer.chunk 126;
 				write_class_ref writer c;
 				write_types writer tl;
 				loop_el el;
+				true;
 			(* unops 140-159 *)
 			| TUnop(op,flag,e1) ->
 				Chunk.write_u8 writer.chunk (140 + unop_index op flag);
 				loop e1;
+				true;
 			(* binops 160-219 *)
 			| TBinop(op,e1,e2) ->
 				Chunk.write_u8 writer.chunk (160 + binop_index op);
 				loop e1;
 				loop e2;
+				true;
 			(* rest 250-254 *)
 			| TIdent s ->
 				Chunk.write_u8 writer.chunk 250;
 				Chunk.write_string writer.chunk s;
-			end;
-			write_texpr_type_instance writer fctx e.etype;
+				true;
+			in
+			if write_type then
+				write_texpr_type_instance writer fctx e.etype;
 			PosWriter.write_pos fctx.pos_writer writer.chunk true 0 e.epos;
 
 		and loop_el el =