Explorar o código

[gencommon] minor reformatting in OverloadingConstructor code

Dan Korostelev %!s(int64=9) %!d(string=hai) anos
pai
achega
e698e5846b
Modificáronse 1 ficheiros con 65 adicións e 70 borrados
  1. 65 70
      src/generators/gencommon.ml

+ 65 - 70
src/generators/gencommon.ml

@@ -1745,35 +1745,34 @@ struct
 				Hashtbl.add processed cl.cl_path true;
 				Hashtbl.add processed cl.cl_path true;
 
 
 				(* make sure we've processed the super types *)
 				(* make sure we've processed the super types *)
-				(match cl.cl_super with
-				| Some (super,_) when should_change super ->
-					change super
-				| _ -> ());
+				Option.may (fun (super,_) -> if should_change super then change super) cl.cl_super;
 
 
 				(* implement static hx_ctor and reimplement constructors *)
 				(* implement static hx_ctor and reimplement constructors *)
 				(try
 				(try
-					let ctor = match cl.cl_constructor with
-					| Some ctor -> ctor
-					| None -> try
-						let sctor, sup, stl = prev_ctor cl (List.map snd cl.cl_params) in
-						(* we'll make constructors that will only call super() *)
-						let ctor = clone_ctors gen sctor sup stl cl in
-						cl.cl_constructor <- Some ctor;
-						ctor
-					with | Not_found -> (* create default constructor *)
-						let ctor = mk_class_field "new" (TFun([], basic.tvoid)) false cl.cl_pos (Method MethNormal) [] in
-						ctor.cf_expr <- Some
-						{
-							eexpr = TFunction {
-								tf_args = [];
-								tf_type = basic.tvoid;
-								tf_expr = { eexpr = TBlock[]; etype = basic.tvoid; epos = cl.cl_pos };
-							};
-							etype = ctor.cf_type;
-							epos = ctor.cf_pos;
-						};
-						cl.cl_constructor <- Some ctor;
-						ctor
+					let ctor =
+						match cl.cl_constructor with
+						| Some ctor ->
+							ctor
+						| None ->
+							try
+								let sctor, sup, stl = prev_ctor cl (List.map snd cl.cl_params) in
+								(* we'll make constructors that will only call super() *)
+								let ctor = clone_ctors gen sctor sup stl cl in
+								cl.cl_constructor <- Some ctor;
+								ctor
+							with Not_found -> (* create default constructor *)
+								let ctor = mk_class_field "new" (TFun ([], basic.tvoid)) false cl.cl_pos (Method MethNormal) [] in
+								ctor.cf_expr <- Some {
+									eexpr = TFunction {
+										tf_args = [];
+										tf_type = basic.tvoid;
+										tf_expr = mk (TBlock []) basic.tvoid cl.cl_pos;
+									};
+									etype = ctor.cf_type;
+									epos = ctor.cf_pos;
+								};
+								cl.cl_constructor <- Some ctor;
+								ctor
 					in
 					in
 					(* now that we made sure we have a constructor, exit if native gen *)
 					(* now that we made sure we have a constructor, exit if native gen *)
 					if not (is_hxgen (TClassDecl cl)) || Meta.has Meta.SkipCtor cl.cl_meta then begin
 					if not (is_hxgen (TClassDecl cl)) || Meta.has Meta.SkipCtor cl.cl_meta then begin
@@ -1788,59 +1787,53 @@ struct
 					else
 					else
 						(* now that we have a current ctor, create the static counterparts *)
 						(* now that we have a current ctor, create the static counterparts *)
 						List.iter (fun cf -> create_static_ctor gen ~empty_ctor_expr:empty_ctor_expr cl cf) (ctor :: ctor.cf_overloads)
 						List.iter (fun cf -> create_static_ctor gen ~empty_ctor_expr:empty_ctor_expr cl cf) (ctor :: ctor.cf_overloads)
-				with | Exit ->());
+				with Exit -> ());
 
 
 				(* implement empty ctor *)
 				(* implement empty ctor *)
 				(try
 				(try
 					(* now that we made sure we have a constructor, exit if native gen *)
 					(* now that we made sure we have a constructor, exit if native gen *)
 					if not (is_hxgen (TClassDecl cl)) then raise Exit;
 					if not (is_hxgen (TClassDecl cl)) then raise Exit;
+
 					(* get first *)
 					(* get first *)
-					let empty_type = TFun(["empty",false,empty_ctor_type],basic.tvoid) in
-					let super = match cl.cl_super with
-					| None -> (* implement empty *)
-							[]
-					| Some (sup,_) -> try
-						ignore (get_last_empty sup);
-						[{
-							eexpr = TCall(
-								{ eexpr = TConst TSuper; etype = TInst(cl, List.map snd cl.cl_params); epos = cl.cl_pos },
-								[ empty_ctor_expr ]);
-							etype = basic.tvoid;
-							epos = cl.cl_pos
-						}]
-					with | Not_found -> try
-						(* super type is native: find super constructor with least arguments *)
-						let sctor, sup, stl = prev_ctor cl (List.map snd cl.cl_params) in
-						let rec loop remaining (best,n) =
-							match remaining with
-							| [] -> best
-							| cf :: r ->
-								let args,_ = get_fun cf.cf_type in
-								if (List.length args) < n then
-									loop r (cf,List.length args)
-								else
-									loop r (best,n)
-						in
-						let args,_ = get_fun sctor.cf_type in
-						let best = loop sctor.cf_overloads (sctor, List.length args) in
-						let args,_ = get_fun (apply_params sup.cl_params stl best.cf_type) in
-						[{
-							eexpr = TCall(
-								{ eexpr = TConst TSuper; etype = TInst(sup, stl); epos = cl.cl_pos },
-								List.map (fun (n,o,t) -> null t cl.cl_pos) args);
-							etype = basic.tvoid;
-							epos = cl.cl_pos
-						}]
-					with | Not_found ->
-						(* extends native type, but no ctor found *)
-						[]
+					let empty_type = TFun (["empty",false,empty_ctor_type],basic.tvoid) in
+					let super =
+						match cl.cl_super with
+						| None -> (* implement empty *)
+								[]
+						| Some (sup,_) ->
+							try
+								ignore (get_last_empty sup);
+								let esuper = mk (TConst TSuper) (TInst (cl, List.map snd cl.cl_params)) cl.cl_pos in
+								[mk (TCall (esuper, [empty_ctor_expr])) basic.tvoid cl.cl_pos]
+							with Not_found ->
+								try
+									(* super type is native: find super constructor with least arguments *)
+									let sctor, sup, stl = prev_ctor cl (List.map snd cl.cl_params) in
+									let rec loop remaining (best,n) =
+										match remaining with
+										| [] -> best
+										| cf :: r ->
+											let args,_ = get_fun cf.cf_type in
+											if (List.length args) < n then
+												loop r (cf,List.length args)
+											else
+												loop r (best,n)
+									in
+									let args,_ = get_fun sctor.cf_type in
+									let best = loop sctor.cf_overloads (sctor, List.length args) in
+									let args,_ = get_fun (apply_params sup.cl_params stl best.cf_type) in
+									let esuper = mk (TConst TSuper) (TInst (sup, stl)) cl.cl_pos in
+									[mk (TCall (esuper, List.map (fun (n,o,t) -> null t cl.cl_pos) args)) basic.tvoid cl.cl_pos]
+								with Not_found ->
+									(* extends native type, but no ctor found *)
+									[]
 					in
 					in
 					let ctor = mk_class_field "new" empty_type false cl.cl_pos (Method MethNormal) [] in
 					let ctor = mk_class_field "new" empty_type false cl.cl_pos (Method MethNormal) [] in
 					ctor.cf_expr <- Some {
 					ctor.cf_expr <- Some {
 						eexpr = TFunction {
 						eexpr = TFunction {
 							tf_type = basic.tvoid;
 							tf_type = basic.tvoid;
 							tf_args = [alloc_var "empty" empty_ctor_type, None];
 							tf_args = [alloc_var "empty" empty_ctor_type, None];
-							tf_expr = { eexpr = TBlock super; etype = basic.tvoid; epos = cl.cl_pos }
+							tf_expr = mk (TBlock super) basic.tvoid cl.cl_pos
 						};
 						};
 						etype = empty_type;
 						etype = empty_type;
 						epos = cl.cl_pos;
 						epos = cl.cl_pos;
@@ -1848,9 +1841,11 @@ struct
 					ctor.cf_meta <- [Meta.SkipCtor, [], ctor.cf_pos];
 					ctor.cf_meta <- [Meta.SkipCtor, [], ctor.cf_pos];
 					Hashtbl.add empty_ctors cl.cl_path ctor;
 					Hashtbl.add empty_ctors cl.cl_path ctor;
 					match cl.cl_constructor with
 					match cl.cl_constructor with
-					| None -> cl.cl_constructor <- Some ctor
-					| Some c -> c.cf_overloads <- ctor :: c.cf_overloads
-				with | Exit -> ());
+					| None ->
+						cl.cl_constructor <- Some ctor
+					| Some c ->
+						c.cf_overloads <- ctor :: c.cf_overloads
+				with Exit -> ());
 			end
 			end
 		in
 		in