浏览代码

[matcher] not sure if this is better...

Simon Krajewski 5 年之前
父节点
当前提交
d2ab0a4063
共有 2 个文件被更改,包括 47 次插入23 次删除
  1. 13 0
      src/core/ds/uniqueMap.ml
  2. 34 23
      src/typing/matcher.ml

+ 13 - 0
src/core/ds/uniqueMap.ml

@@ -0,0 +1,13 @@
+include PMap
+
+let maybe_add k v l =
+	if not (PMap.mem k l) then
+		PMap.add k v l
+	else
+		l
+
+let keys l =
+	PMap.foldi (fun k _ acc -> k :: acc) l []
+
+let values l =
+	PMap.fold (fun v acc -> v :: acc) l []

+ 34 - 23
src/typing/matcher.ml

@@ -409,43 +409,54 @@ module Pattern = struct
 				in
 				pattern t
 			| EObjectDecl fl ->
-				let rec known_fields t = match follow t with
+				let known_fields = ref UniqueMap.empty in
+				let add (cf,v) = known_fields := UniqueMap.maybe_add cf.cf_name (cf,v) !known_fields in
+				let rec collect_known_fields whitelist t =
+					let add = match whitelist with
+						| [] ->
+							add
+						| _ ->
+							(fun (cf,v) -> if List.mem cf.cf_name whitelist then add (cf,v))
+					in
+					match follow t with
 					| TAnon an ->
-						PMap.fold (fun cf acc -> (cf,cf.cf_type) :: acc) an.a_fields []
+						PMap.iter (fun _ cf -> add (cf,cf.cf_type)) an.a_fields
 					| TInst(c,tl) ->
-						let rec loop fields c tl =
-							let fields = List.fold_left (fun acc cf ->
-								if Typecore.can_access ctx c cf false then (cf,apply_params c.cl_params tl cf.cf_type) :: acc
-								else acc
-							) fields c.cl_ordered_fields in
+						let rec loop c tl =
+							List.iter (fun cf ->
+								if Typecore.can_access ctx c cf false then
+									add (cf,apply_params c.cl_params tl cf.cf_type)
+							) c.cl_ordered_fields;
 							match c.cl_super with
-								| None -> fields
-								| Some (csup,tlsup) -> loop fields csup (List.map (apply_params c.cl_params tl) tlsup)
+								| None -> ()
+								| Some (csup,tlsup) -> loop csup (List.map (apply_params c.cl_params tl) tlsup)
 						in
-						loop [] c tl
+						loop c tl
 					| TAbstract({a_impl = Some c} as a,tl) ->
-						let fields = try
+						begin
+							List.iter (fun cf ->
+								if Meta.has Meta.Impl cf.cf_meta then
+									add (cf,apply_params a.a_params tl cf.cf_type)
+								else
+									()
+							) c.cl_ordered_statics;
+						end;
+						begin try
 							let _,el,_ = Meta.get Meta.Forward a.a_meta in
 							let sl = ExtList.List.filter_map (fun e -> match fst e with
 								| EConst(Ident s) -> Some s
 								| _ -> None
 							) el in
-							let fields = known_fields (Abstract.get_underlying_type a tl) in
-							if sl = [] then fields else List.filter (fun (cf,t) -> List.mem cf.cf_name sl) fields
+							collect_known_fields sl (Abstract.get_underlying_type a tl);
 						with Not_found ->
-							[]
-						in
-						let fields = List.fold_left (fun acc cf ->
-							if Meta.has Meta.Impl cf.cf_meta then
-								(cf,apply_params a.a_params tl cf.cf_type) :: acc
-							else
-								acc
-						) fields c.cl_ordered_statics in
-						fields
+							()
+						end;
+						()
 					| _ ->
 						error (Printf.sprintf "Cannot field-match against %s" (s_type t)) (pos e)
 				in
-				let known_fields = known_fields t in
+				collect_known_fields [] t;
+				let known_fields = UniqueMap.values !known_fields in
 				let is_matchable cf =
 					match cf.cf_kind with Method _ -> false | _ -> true
 				in