From e533c12c974c2cca39cbb65cfd67abea8497e4e8 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Fri, 2 Jun 2017 18:31:14 +0200 Subject: [PATCH] group extractors to avoid code explosion (closes #6322) --- src/typing/matcher.ml | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/typing/matcher.ml b/src/typing/matcher.ml index 450a841e4fc..f8158fe7e12 100644 --- a/src/typing/matcher.ml +++ b/src/typing/matcher.ml @@ -1038,23 +1038,25 @@ module Compile = struct let pat_any = (PatAny,null_pos) in let _,_,ex_subjects,cases,bindings = List.fold_left2 (fun (left,right,subjects,cases,ex_bindings) (case,bindings,patterns) extractor -> match extractor,patterns with | Some(v,e1,pat,vars), _ :: patterns -> - let patterns = make_offset_list (left + 1) (right - 1) pat pat_any @ patterns in let rec loop e = match e.eexpr with | TLocal v' when v' == v -> subject | _ -> Type.map_expr loop e in let e1 = loop e1 in let bindings = List.map (fun v -> v,subject.epos,subject) vars @ bindings in - let v,ex_bindings = try - let v,_,_ = List.find (fun (_,_,e2) -> Texpr.equal e1 e2) ex_bindings in - v,ex_bindings + begin try + let v,_,_,left,right = List.find (fun (_,_,e2,_,_) -> Texpr.equal e1 e2) ex_bindings in + let ev = mk (TLocal v) v.v_type e1.epos in + let patterns = make_offset_list (left + 1) (right - 1) pat pat_any @ patterns in + (left + 1, right - 1,ev :: subjects,((case,bindings,patterns) :: cases),ex_bindings) with Not_found -> let v = alloc_var "_hx_tmp" e1.etype e1.epos in v.v_meta <- (Meta.Custom ":extractorVariable",[],v.v_pos) :: v.v_meta; - v,(v,e1.epos,e1) :: ex_bindings - in - let ev = mk (TLocal v) v.v_type e1.epos in - (left + 1, right - 1,ev :: subjects,((case,bindings,patterns) :: cases),ex_bindings) + let ex_bindings = (v,e1.epos,e1,left,right) :: ex_bindings in + let patterns = make_offset_list (left + 1) (right - 1) pat pat_any @ patterns in + let ev = mk (TLocal v) v.v_type e1.epos in + (left + 1, right - 1,ev :: subjects,((case,bindings,patterns) :: cases),ex_bindings) + end | None,pat :: patterns -> let patterns = make_offset_list 0 num_extractors pat pat_any @ patterns in (left,right,subjects,((case,bindings,patterns) :: cases),ex_bindings) @@ -1062,6 +1064,7 @@ module Compile = struct assert false ) (0,num_extractors,[],[],[]) cases (List.rev extractors) in let dt = compile mctx ((subject :: List.rev ex_subjects) @ subjects) (List.rev cases) in + let bindings = List.map (fun (a,b,c,_,_) -> (a,b,c)) bindings in bind mctx bindings dt let compile ctx match_debug subjects cases p =