Prechádzať zdrojové kódy

[matcher] remove PatVariable, use PatBind(v, PatAny) instead

Simon Krajewski 2 rokov pred
rodič
commit
ac2539149f

+ 7 - 10
src/typing/matcher/compile.ml

@@ -81,8 +81,6 @@ let specialize subject con cases =
 	let rec specialize (case,bindings,patterns) = match patterns with
 		| (PatConstructor(con',patterns1),_) :: patterns2 when Constructor.equal con con' ->
 			Some (case,bindings,patterns1 @ patterns2)
-		| (PatVariable v,p) :: patterns2 ->
-			Some (case,(make_bind v p subject) :: bindings,ExtList.List.make arity (PatAny,p) @ patterns2)
 		| (PatAny,_) as pat :: patterns2 ->
 			Some (case,bindings,ExtList.List.make arity pat @ patterns2)
 		| (PatBind(v,pat1),p) :: patterns ->
@@ -94,8 +92,6 @@ let specialize subject con cases =
 
 let default subject cases =
 	let rec default (case,bindings,patterns) = match patterns with
-		| (PatVariable v,p) :: patterns ->
-			Some (case,((make_bind v p subject) :: bindings),patterns)
 		| (PatAny,_) :: patterns ->
 			Some (case,bindings,patterns)
 		| (PatBind(v,pat1),p) :: patterns ->
@@ -106,7 +102,7 @@ let default subject cases =
 	ExtList.List.filter_map default cases
 
 let rec is_wildcard_pattern pat = match fst pat with
-	| PatVariable _ | PatAny -> true
+	| PatAny -> true
 	| PatBind(_,pat1) -> is_wildcard_pattern pat1
 	| _ -> false
 
@@ -143,7 +139,7 @@ let s_cases cases =
 
 let select_column subjects cases =
 	let rec loop i patterns = match patterns with
-		| ((PatVariable _ | PatAny | PatExtractor _),_) :: patterns -> loop (i + 1) patterns
+		| ((PatAny | PatExtractor _),_) :: patterns -> loop (i + 1) patterns
 		| (PatBind(_,pat1),_) :: patterns -> loop i (pat1 :: patterns)
 		| [] -> 0
 		| _ -> i
@@ -196,8 +192,6 @@ and compile_leaf mctx subjects (case,bindings,patterns) cases =
 	let rec loop patterns subjects bindings = match patterns,subjects with
 		| [PatAny,_],_ ->
 			bindings
-		| (PatVariable v,p) :: patterns,subject :: subjects ->
-			loop patterns subjects ((make_bind v p subject#get_assigned_expr) :: bindings)
 		| (PatBind(v,pat1),p) :: patterns,subject :: subjects ->
 			loop (pat1 :: patterns) (subject :: subjects) ((make_bind v p subject#get_assigned_expr) :: bindings)
 		| _ :: patterns,_ :: subjects ->
@@ -231,8 +225,11 @@ and compile_switch mctx subjects cases =
 					if case.case_guard = None then ConTable.replace unguarded con true;
 					let arg_positions = snd (List.split patterns) in
 					ConTable.replace sigma con arg_positions;
-				| PatBind(v,pat1) -> loop ((make_bind v (pos pat) subject) :: bindings) pat1
-				| PatVariable _ | PatAny -> ()
+				| PatBind(_,(PatAny,_)) ->
+					()
+				| PatBind(v,pat1) ->
+					loop ((make_bind v (pos pat) subject) :: bindings) pat1
+				| PatAny -> ()
 				| PatExtractor _ -> raise Extractor
 				| _ -> raise_typing_error ("Unexpected pattern: " ^ (Pattern.to_string pat)) case.case_pos;
 			in

+ 2 - 2
src/typing/matcher/exprToPattern.ml

@@ -210,7 +210,7 @@ let rec make pctx toplevel t e =
 					| l -> warning pctx.ctx WTyper ("Potential typo detected (expected similar values are " ^ (String.concat ", " l) ^ "). Consider using `var " ^ s ^ "` instead") p
 				end;
 				let v = add_local false s p in
-				PatVariable v
+				PatBind(v, (PatAny,null_pos))
 			end
 	in
 	let rec loop e = match fst e with
@@ -248,7 +248,7 @@ let rec make pctx toplevel t e =
 			end
 		| EVars([{ ev_name = (s,p); ev_final = final; ev_type = None; ev_expr = None; }]) ->
 			let v = add_local final s p in
-			PatVariable v
+			PatBind(v,(PatAny,null_pos))
 		| ECall(e1,el) ->
 			let e1 = type_expr ctx e1 (WithType.with_type t) in
 			begin match e1.eexpr,follow e1.etype with

+ 1 - 2
src/typing/matcher/pattern.ml

@@ -5,7 +5,6 @@ open MatcherGlobals
 
 type t =
 	| PatConstructor of Constructor.t * pattern list
-	| PatVariable of tvar
 	| PatAny
 	| PatBind of tvar * pattern
 	| PatOr of pattern * pattern
@@ -22,8 +21,8 @@ and extractor = {
 
 let rec to_string pat = match fst pat with
 	| PatConstructor(con,patterns) -> Printf.sprintf "%s(%s)" (Constructor.to_string con) (String.concat ", " (List.map to_string patterns))
-	| PatVariable v -> Printf.sprintf "%s<%i>" v.v_name v.v_id
 	| PatAny -> "_"
+	| PatBind(v,(PatAny,_)) -> Printf.sprintf "%s<%i>" v.v_name v.v_id
 	| PatBind(v,pat1) -> Printf.sprintf "%s = %s" v.v_name (to_string pat1)
 	| PatOr(pat1,pat2) -> Printf.sprintf "(%s) | (%s)" (to_string pat1) (to_string pat2)
 	| PatTuple pl -> Printf.sprintf "[%s]" (String.concat ", " (List.map to_string pl))

+ 4 - 4
src/typing/matcher/useless.ml

@@ -40,7 +40,7 @@ let default pM =
 	let rec loop acc pM = match pM with
 		| patterns :: pM ->
 			begin match patterns with
-				| ((PatVariable _ | PatAny),_) :: patterns ->
+				| ((PatBind(_,(PatAny,_)) | PatAny),_) :: patterns ->
 					loop (patterns :: acc) pM
 				| _ ->
 					loop acc pM
@@ -62,7 +62,7 @@ let rec u pM q =
 			| PatTuple patterns ->
 				let s = specialize true (ConConst TNull,pos pat) pM in
 				u s (patterns @ ql)
-			| (PatVariable _ | PatAny) ->
+			| PatAny ->
 				let d = default pM in
 				u d ql
 			| PatOr(pat1,pat2) ->
@@ -94,7 +94,7 @@ let rec specialize' is_tuple con pM qM rM =
 					loop ((patterns1 @ patterns2) :: pAcc) (q1 :: qAcc) (r1 :: rAcc) pM qM rM
 				| (PatTuple patterns1,_) :: patterns2 when is_tuple ->
 					loop ((patterns1 @ patterns2) :: pAcc) (q1 :: qAcc) (r1 :: rAcc) pM qM rM
-				| ((PatVariable _ | PatAny),p) :: patterns2 ->
+				| (PatAny,p) :: patterns2 ->
 					let patterns1 = ExtList.List.make arity (PatAny,p) in
 					loop ((patterns1 @ patterns2) :: pAcc) (q1 :: qAcc) (r1 :: rAcc) pM qM rM
 				| (PatOr(pat1,pat2),_) :: patterns2 ->
@@ -162,7 +162,7 @@ let rec u' pM qM rM p q r =
 			| PatTuple patterns ->
 				let pM,qM,rM = specialize' true (ConConst TNull,pos pat) pM qM rM in
 				u' pM qM rM (patterns @ pl) q r
-			| PatAny | PatVariable _ ->
+			| PatAny ->
 				let pM,qM = transfer_column pM qM in
 				u' pM qM rM pl (pat :: q) r
 			| PatOr _ ->