소스 검색

change dt structure

Simon Krajewski 12 년 전
부모
커밋
9cdaeb67ce
4개의 변경된 파일54개의 추가작업 그리고 36개의 파일을 삭제
  1. 14 6
      codegen.ml
  2. 7 8
      genneko.ml
  3. 9 7
      matcher.ml
  4. 24 15
      type.ml

+ 14 - 6
codegen.ml

@@ -1541,7 +1541,7 @@ module PatternMatchConversion = struct
 		dt_lookup : dt array;
 	}
 
-	let mk_st def t p = {
+(* 	let mk_st def t p = {
 		st_def = def;
 		st_type = t;
 		st_pos = p;
@@ -1613,7 +1613,15 @@ module PatternMatchConversion = struct
 		match dt with
 		| Goto i ->
 			to_typed_ast cctx (cctx.dt_lookup.(i))
-		| Out(e,eo,dt) ->
+		| Expr e -> replace_locals cctx e
+		| Guard (e,dt1,dt2) ->
+			begin match dt2 with
+			| None -> mk (TIf(e,to_typed_ast cctx dt1,None)) t_dynamic e.epos
+			| Some dt ->
+				let eelse = to_typed_ast cctx dt in
+				mk (TIf(e,to_typed_ast cctx dt1,Some eelse)) eelse.etype (punion e.epos eelse.epos)
+			end
+(* 		| Out(e,eo,dt) ->
 			replace_locals cctx begin match eo,dt with
 				| Some eg,None ->
 					mk (TIf(eg,e,None)) t_dynamic e.epos
@@ -1623,7 +1631,7 @@ module PatternMatchConversion = struct
 				| _,None ->
 					e
 				| _ -> assert false
-			end
+			end *)
 		| Bind (bl, dt) ->
 			List.iter (fun ((v,_),st) ->
 				let e = st_to_texpr cctx st in
@@ -1653,7 +1661,7 @@ module PatternMatchConversion = struct
 				let eif = mk (TBinop(OpEq,(mk (TConst TNull) st.st_type st.st_pos),eval)) cctx.ctx.t.tbool ethen.epos in
 				mk (TIf(eif,ethen,Some e)) ethen.etype ethen.epos
 			| _ ->
-				assert false	
+				assert false
 
 	and group_cases cctx cases to_case =
 		let def = ref None in
@@ -1791,7 +1799,7 @@ module PatternMatchConversion = struct
 		let eval = st_to_texpr cctx st in
 		let eval = mk (TField(eval,quick_field eval.etype "length")) cctx.ctx.com.basic.tint st.st_pos in
 		mk (TSwitch(eval,cases,!def)) cctx.out_type eval.epos
-
+ *)
 	let to_typed_ast ctx dt p =
 		let first = dt.dt_dt_lookup.(dt.dt_first) in
 		let cctx = {
@@ -1802,7 +1810,7 @@ module PatternMatchConversion = struct
 			dt_lookup = dt.dt_dt_lookup;
 		} in
 		(* generate typed AST from decision tree *)
-		let e = to_typed_ast cctx first in
+		let e = mk (TConst TNull) t_dynamic p in
 		let e = { e with epos = p; etype = dt.dt_type} in
 		if dt.dt_var_init = [] then
 			e

+ 7 - 8
genneko.ml

@@ -468,14 +468,13 @@ and gen_expr ctx e =
 					(EBinop ("=",field p (ident p "@state") v.v_name,gen_st st),p)
 				) bl in
 				EBlock (block @ [loop dt]),p
-			| Out(e,eo,dt) ->
-				begin match eo,dt with
- 					| Some eg,None -> (EIf (gen_expr ctx eg,gen_expr ctx e,None),p)
-					| Some eg,Some dt -> (EIf (gen_expr ctx eg,gen_expr ctx e,Some (loop dt)),p)
-					| _,None ->
-						let state = Hashtbl.fold (fun n _ l -> (n, Some (field p (ident p "@state") n)) :: l) state [] in
-						assign_return state (gen_expr ctx e)
-					| None,Some _ -> assert false
+			| Expr e ->
+				let state = Hashtbl.fold (fun n _ l -> (n, Some (field p (ident p "@state") n)) :: l) state [] in
+				assign_return state (gen_expr ctx e)
+			| Guard (e,dt1,dt2) ->
+				begin match dt2 with
+ 					| None -> (EIf (gen_expr ctx e,loop dt1,None),p)
+					| Some dt -> (EIf (gen_expr ctx e,loop dt1,Some (loop dt)),p)
 				end
 			| Switch (st,cl) ->
 				let est = gen_st st in

+ 9 - 7
matcher.ml

@@ -757,10 +757,9 @@ let rec compile mctx stl pmat =
 		if i = -1 then begin
 			Hashtbl.replace mctx.used_paths out.o_id true;
 			let bl = bind_remaining out pv stl in
-			let dt = if out.o_guard = None || match pl with [] -> true | _ -> false then
-				Out(out.o_expr,out.o_guard,None)
-			else
-				Out(out.o_expr,out.o_guard,Some (compile mctx stl pl))
+			let dt = match out.o_guard with
+				| None -> Expr out.o_expr
+				| Some e -> Guard (e, Expr out.o_expr, match pl with [] -> None | _ -> Some (compile mctx stl pl))
 			in
 			if bl = [] then dt else Bind(bl,dt)
 		end else if i > 0 then begin
@@ -1035,15 +1034,18 @@ let match_expr ctx e cases def with_type p =
 		| Goto i -> Array.set count i (count.(i))
 		| Switch(_,cl) -> List.iter (fun (_,dt) -> loop dt) cl
 		| Bind(_,dt) -> loop dt
-		| Out(_,_,Some dt) -> loop dt
-		| _ -> ()
+		| Expr _ -> ()
+		| Guard (_,dt1,dt2) ->
+			loop dt1;
+			(match dt2 with None -> () | Some dt -> loop dt)
 	in
 	Array.iter loop lut;
 	let rec loop dt = match dt with
 		| Goto i -> if count.(i) < 2 then lut.(i) else Goto i
 		| Switch(st,cl) -> Switch(st, List.map (fun (c,dt) -> c, loop dt) cl)
 		| Bind(bl,dt) -> Bind(bl,loop dt)
-		| Out(e,eo,dt) -> Out(e,eo, match dt with None -> None | Some dt -> Some (loop dt))
+		| Expr e -> Expr e
+		| Guard(e,dt1,dt2) -> Guard(e,loop dt1, match dt2 with None -> None | Some dt -> Some (loop dt))
 	in
 	{
 		dt_first = first;

+ 24 - 15
type.ml

@@ -320,10 +320,12 @@ and st = {
 }
 
 and dt =
-	| Out of texpr * texpr option * dt option
+	(* | Out of texpr * texpr option * dt option *)
 	| Switch of st * (con * dt) list
 	| Bind of ((tvar * pos) * st) list * dt
 	| Goto of int
+	| Expr of texpr
+	| Guard of texpr * dt * dt option
 
 and decision_tree = {
 	dt_dt_lookup : dt array;
@@ -1359,13 +1361,18 @@ let iter f e =
 		(match def with None -> () | Some e -> f e)
 	| TPatMatch dt ->
 		let rec loop dt = match dt with
-			| Out(e,eo,dt) ->
+(* 			| Out(e,eo,dt) ->
 				f e;
 				(match eo with None -> () | Some e -> f e);
-				(match dt with None -> () | Some dt -> loop dt);
+				(match dt with None -> () | Some dt -> loop dt); *)
 			| Bind(_,dt) -> loop dt
 			| Goto _ -> ()
 			| Switch(_,cl) -> List.iter (fun (_,dt) -> loop dt) cl
+			| Expr e -> f e
+			| Guard(eg,dt1,dt2) ->
+				f eg;
+				loop dt1;
+				(match dt2 with None -> () | Some dt -> loop dt)
 		in
 		Array.iter loop dt.dt_dt_lookup
 	| TTry (e,catches) ->
@@ -1420,13 +1427,15 @@ let map_expr f e =
 		{ e with eexpr = TMatch (f e1, t, List.map (fun (cl,params,e) -> cl, params, f e) cases, match def with None -> None | Some e -> Some (f e)) }
 	| TPatMatch dt ->
 		let rec loop dt = match dt with
-			| Out(e,eo,dt) ->
-				Out(f e, (match eo with None -> None | Some e -> Some (f e)), (match dt with None -> None | Some dt -> Some (loop dt)));
+(* 			| Out(e,eo,dt) ->
+				Out(f e, (match eo with None -> None | Some e -> Some (f e)), (match dt with None -> None | Some dt -> Some (loop dt))); *)
 			| Bind(vl,dt) -> Bind(vl, loop dt)
 			| Goto _ -> dt
 			| Switch(st,cl) -> Switch(st, List.map (fun (c,dt) -> c,loop dt) cl)
+			| Expr e -> Expr(f e)
+			| Guard(e,dt1,dt2) -> Guard(f e,loop dt1,match dt2 with None -> None | Some dt -> Some (loop dt))
 		in
-		{ e with eexpr = TPatMatch({dt with dt_dt_lookup = Array.map loop dt.dt_dt_lookup})}		
+		{ e with eexpr = TPatMatch({dt with dt_dt_lookup = Array.map loop dt.dt_dt_lookup})}
 	| TTry (e1,catches) ->
 		{ e with eexpr = TTry (f e1, List.map (fun (v,e) -> v, f e) catches) }
 	| TReturn eo ->
@@ -1498,13 +1507,15 @@ let map_expr_type f ft fv e =
 		{ e with eexpr = TMatch (f e1, (en,List.map ft pl), List.map map_case cases, match def with None -> None | Some e -> Some (f e)); etype = ft e.etype }
 	| TPatMatch dt ->
 		let rec loop dt = match dt with
-			| Out(e,eo,dt) ->
-				Out(f e, (match eo with None -> None | Some e -> Some (f e)), (match dt with None -> None | Some dt -> Some (loop dt)));
+(* 			| Out(e,eo,dt) ->
+				Out(f e, (match eo with None -> None | Some e -> Some (f e)), (match dt with None -> None | Some dt -> Some (loop dt))); *)
 			| Bind(vl,dt) -> Bind(vl, loop dt)
 			| Goto _ -> dt
 			| Switch(st,cl) -> Switch(st, List.map (fun (c,dt) -> c,loop dt) cl)
+			| Expr e -> Expr(f e)
+			| Guard (e,dt1,dt2) -> Guard(f e, loop dt, match dt2 with None -> None | Some dt -> Some (loop dt))
 		in
-		{ e with eexpr = TPatMatch({dt with dt_dt_lookup = Array.map loop dt.dt_dt_lookup}); etype = ft e.etype}		
+		{ e with eexpr = TPatMatch({dt with dt_dt_lookup = Array.map loop dt.dt_dt_lookup}); etype = ft e.etype}
 	| TTry (e1,catches) ->
 		{ e with eexpr = TTry (f e1, List.map (fun (v,e) -> fv v, f e) catches); etype = ft e.etype }
 	| TReturn eo ->
@@ -1579,10 +1590,6 @@ and s_dt tabs tree =
 		| SField (st,n) -> s_st st ^ "." ^ n)
 	in
 	tabs ^ match tree with
-	| Out(e,eo,None)->
-		s_expr s_type e
-	| Out(e,eo,Some dt) ->
-		"if (" ^ (s_expr s_type (match eo with Some e -> e | None -> assert false)) ^ ") " ^ (s_expr s_type e) ^ " else " ^ s_dt tabs dt
 	| Switch (st, cl) ->
 		"switch(" ^ (s_st st) ^ ") { \n" ^ tabs
 		^ (String.concat ("\n" ^ tabs) (List.map (fun (c,dt) ->
@@ -1592,6 +1599,8 @@ and s_dt tabs tree =
 	| Bind (bl, dt) -> "bind " ^ (String.concat "," (List.map (fun ((v,_),st) -> v.v_name ^ "(" ^ (string_of_int v.v_id) ^ ") =" ^ (s_st st)) bl)) ^ "\n" ^ (s_dt tabs dt)
 	| Goto i ->
 		"goto " ^ (string_of_int i)
+	| Expr e -> s_expr s_type e
+	| Guard (e,dt1,dt2) -> "if(" ^ (s_expr s_type e) ^ ") " ^ (s_dt tabs dt1) ^ (match dt2 with None -> "" | Some dt -> " else " ^ (s_dt tabs dt))
 
 and s_expr s_type e =
 	let sprintf = Printf.sprintf in
@@ -1730,7 +1739,7 @@ let rec s_expr_pretty tabs s_type e =
 		) cases in
 		let s = sprintf "switch (%s) {\n%s%s" (loop e) cases (match def with None -> "" | Some e -> ntabs ^ "default: " ^ (s_expr_pretty ntabs s_type e) ^ "\n") in
 		s ^ tabs ^ "}"
-	| TPatMatch dt -> s_dt tabs (dt.dt_dt_lookup.(dt.dt_first))	
+	| TPatMatch dt -> s_dt tabs (dt.dt_dt_lookup.(dt.dt_first))
 	| TTry (e,cl) ->
 		sprintf "try %s%s" (loop e) (slist (fun (v,e) -> sprintf "catch( %s : %s ) %s" v.v_name (s_type v.v_type) (loop e)) cl)
 	| TReturn None ->
@@ -1748,4 +1757,4 @@ let rec s_expr_pretty tabs s_type e =
 	| TCast (e,Some mt) ->
 		sprintf "cast (%s,%s)" (loop e) (s_type_path (t_path mt))
 	| TMeta ((n,el,_),e) ->
-		sprintf "@%s%s %s" (Meta.to_string n) (match el with [] -> "" | _ -> "(" ^ (String.concat ", " (List.map Ast.s_expr el)) ^ ")") (loop e)		
+		sprintf "@%s%s %s" (Meta.to_string n) (match el with [] -> "" | _ -> "(" ^ (String.concat ", " (List.map Ast.s_expr el)) ^ ")") (loop e)