瀏覽代碼

cl_overrides is now a list of class fields (can store several overloads with same name if necessary)

Nicolas Cannasse 12 年之前
父節點
當前提交
14c97916f3
共有 8 個文件被更改,包括 18 次插入18 次删除
  1. 1 1
      codegen.ml
  2. 1 1
      dce.ml
  3. 4 4
      gencpp.ml
  4. 3 3
      genphp.ml
  5. 2 2
      genswf9.ml
  6. 1 1
      genxml.ml
  7. 1 1
      type.ml
  8. 5 5
      typeload.ml

+ 1 - 1
codegen.ml

@@ -691,7 +691,7 @@ let add_field_inits ctx t =
 				let e = Type.map_expr (use_this v) e in
 				let cf = {cf with cf_expr = Some e} in
 				(* if the method is an override, we have to remove the class field to not get invalid overrides *)
-				let fields = if List.mem cf.cf_name c.cl_overrides then begin
+				let fields = if List.memq cf c.cl_overrides then begin
 					c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
 					fields
 				end else

+ 1 - 1
dce.ml

@@ -471,7 +471,7 @@ let run com main full =
 			c.cl_overrides <- List.filter (fun s ->
 				let rec loop c =
 					match c.cl_super with
-					| Some (csup,_) when PMap.mem s csup.cl_fields -> true
+					| Some (csup,_) when PMap.mem s.cf_name csup.cl_fields -> true
 					| Some (csup,_) -> loop csup
 					| None -> false
 				in

+ 4 - 4
gencpp.ml

@@ -204,7 +204,7 @@ let new_extern_context common_ctx writer debug file_info =
   ctx.ctx_for_extern <- true;
   ctx
 ;;
-  
+
 
 (* The internal classes are implemented by the core hxcpp system, so the cpp
 	 classes should not be generated *)
@@ -1077,7 +1077,7 @@ let call_has_side_effects func args =
 
 *)
 
-  
+
 
 let has_side_effects expr = false;;
 let call_has_side_effects func args = false;;
@@ -1993,7 +1993,7 @@ let is_data_member field =
 
 
 let is_override class_def field =
-   List.mem field class_def.cl_overrides
+   List.exists (fun f -> f.cf_name = field) class_def.cl_overrides
 ;;
 
 let rec all_virtual_functions clazz =
@@ -3477,7 +3477,7 @@ let gen_extern_class common_ctx class_def file_info =
       | TInst ({cl_path=cpath,suffix } as cval ,tl) when cpath=filterPath ->
             TInst ( { cval with cl_path = ([],suffix) }, List.map (remove_prefix field) tl)
       | TInst (cval,tl) -> TInst ( cval, List.map (remove_prefix field) tl)
-      (*| TInst ({cl_path=prefix} as cval ,tl) -> 
+      (*| TInst ({cl_path=prefix} as cval ,tl) ->
             TInst ( { cval with cl_path = ([],snd cval.cl_path) }, List.map (remove_prefix field) tl)*)
       | t -> Type.map (remove_prefix field) t
       in

+ 3 - 3
genphp.ml

@@ -225,7 +225,7 @@ let as_string_expr ctx e =
 		to_string ctx e
 	| _ -> e
 (* for known String type that could have null value *)
-let to_string_null ctx e = 
+let to_string_null ctx e =
 	let v = alloc_var "__call__" t_dynamic in
 	let f = mk (TLocal v) t_dynamic e.epos in
 	mk (TCall (f, [ Codegen.string ctx.com "_hx_string_or_null" e.epos; e])) ctx.com.basic.tstring e.epos
@@ -301,7 +301,7 @@ let escape_bin s =
 haxe reserved words that match php ones: break, case, class, continue, default, do, else, extends, for, function, if, new, return, static, switch, var, while, interface, implements, public, private, try, catch, throw
  *)
 (* PHP only (for future use): cfunction, old_function *)
-let is_keyword n = 
+let is_keyword n =
 	match String.lowercase n with
 	| "and" | "or" | "xor" | "__file__" | "exception" | "__line__" | "array"
 	| "as" | "const" | "declare" | "die" | "echo"| "elseif" | "empty"
@@ -2231,7 +2231,7 @@ let generate com =
 		let special_cases = ["toString"] in
 		let loop c lst static =
 			let in_special_cases name =
-				(List.exists (fun n -> String.lowercase n = name) (special_cases @ c.cl_overrides))
+				(List.exists (fun n -> String.lowercase n = name) (special_cases @ List.map (fun f -> f.cf_name) c.cl_overrides))
 			in
 			List.iter(fun cf ->
 				let name = String.lowercase cf.cf_name in

+ 2 - 2
genswf9.ml

@@ -1965,7 +1965,7 @@ let generate_field_kind ctx f c stat =
 				PMap.exists name c.cl_fields || loop c name
 		in
 		(match f.cf_kind with
-		| Method MethDynamic when List.mem f.cf_name c.cl_overrides ->
+		| Method MethDynamic when List.memq f c.cl_overrides ->
 			None
 		| Var _ | Method MethDynamic ->
 			Some (HFVar {
@@ -2039,7 +2039,7 @@ let generate_class ctx c =
 		let rec find_meta c =
 			try
 				let f = PMap.find f.cf_name (if stat then c.cl_statics else c.cl_fields) in
-				if List.mem f.cf_name c.cl_overrides then raise Not_found;
+				if List.memq f c.cl_overrides then raise Not_found;
 				f.cf_meta
 			with Not_found ->
 				match c.cl_super with

+ 1 - 1
genxml.ml

@@ -419,7 +419,7 @@ let generate_type com t =
 		p "%s" (String.concat " " (List.rev ext));
 		p " {\n";
 		let sort l =
-			let a = Array.of_list (List.filter (fun f -> f.cf_public && not (List.mem f.cf_name c.cl_overrides)) l) in
+			let a = Array.of_list (List.filter (fun f -> f.cf_public && not (List.memq f c.cl_overrides)) l) in
 			let name = function "new" -> "" | n -> n in
 			Array.sort (fun f1 f2 ->
 				match f1.cf_kind, f2.cf_kind with

+ 1 - 1
type.ml

@@ -198,7 +198,7 @@ and tclass = {
 	mutable cl_array_access : t option;
 	mutable cl_constructor : tclass_field option;
 	mutable cl_init : texpr option;
-	mutable cl_overrides : string list;
+	mutable cl_overrides : tclass_field list;
 
 	mutable cl_build : unit -> unit;
 	mutable cl_restore : unit -> unit;

+ 5 - 5
typeload.ml

@@ -629,7 +629,7 @@ let check_overriding ctx c =
 		(match c.cl_overrides with
 		| [] -> ()
 		| i :: _ ->
-			display_error ctx ("Field " ^ i ^ " is declared 'override' but doesn't override any field") p)
+			display_error ctx ("Field " ^ i.cf_name ^ " is declared 'override' but doesn't override any field") p)
 	| Some (csup,params) ->
 		PMap.iter (fun i f ->
 			let p = f.cf_pos in
@@ -639,7 +639,7 @@ let check_overriding ctx c =
 				(match f2.cf_kind with
 				| Var { v_read = AccRequire _ } -> raise Not_found;
 				| _ -> ());
-				if not (List.mem i c.cl_overrides) then
+				if not (List.memq f c.cl_overrides) then
 					display_error ctx ("Field " ^ i ^ " should be declared with 'override' since it is inherited from superclass") p
 				else if not f.cf_public && f2.cf_public then
 					display_error ctx ("Field " ^ i ^ " has less visibility (public/private) than superclass one") p
@@ -660,7 +660,7 @@ let check_overriding ctx c =
 						display_error ctx (error_msg (Unify l)) p;
 			with
 				Not_found ->
-					if List.mem i c.cl_overrides then display_error ctx ("Field " ^ i ^ " is declared 'override' but doesn't override any field") p
+					if List.memq f c.cl_overrides then display_error ctx ("Field " ^ i ^ " is declared 'override' but doesn't override any field") p
 		) c.cl_fields
 
 let class_field_no_interf c i =
@@ -986,7 +986,7 @@ let init_core_api ctx c =
 			) fcore;
 			PMap.iter (fun i f ->
 				let p = (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
-				if f.cf_public && not (Meta.has Meta.Hack f.cf_meta) && not (PMap.mem f.cf_name fcore) && not (List.mem f.cf_name c.cl_overrides) then error ("Public field " ^ i ^ " is not part of core type") p;
+				if f.cf_public && not (Meta.has Meta.Hack f.cf_meta) && not (PMap.mem f.cf_name fcore) && not (List.memq f c.cl_overrides) then error ("Public field " ^ i ^ " is not part of core type") p;
 			) fl;
 		in
 		check_fields ccore.cl_fields c.cl_fields;
@@ -1540,7 +1540,7 @@ let init_class ctx c p context_init herits fields =
 				end else begin
 					c.cl_fields <- PMap.add f.cf_name f c.cl_fields;
 					c.cl_ordered_fields <- f :: c.cl_ordered_fields;
-					if List.mem AOverride fd.cff_access then c.cl_overrides <- f.cf_name :: c.cl_overrides;
+					if List.mem AOverride fd.cff_access then c.cl_overrides <- f :: c.cl_overrides;
 				end;
 			end
 		with Error (Custom str,p) ->