2
0
Simon Krajewski 12 жил өмнө
parent
commit
ccd761863b
5 өөрчлөгдсөн 83 нэмэгдсэн , 4 устгасан
  1. 1 1
      codegen.ml
  2. 1 1
      common.ml
  3. 77 1
      genneko.ml
  4. 1 1
      typecore.ml
  5. 3 0
      typeload.ml

+ 1 - 1
codegen.ml

@@ -1811,7 +1811,7 @@ module PatternMatchConversion = struct
 				mk (TVars dt.dt_var_init) t_dynamic e.epos;
 				e;
 			]) dt.dt_type e.epos
-		end			
+		end
 end
 
 (* -------------------------------------------------------------------------- *)

+ 1 - 1
common.ml

@@ -482,7 +482,7 @@ let get_config com =
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
 			pf_overload = false;
-			pf_pattern_matching = false;
+			pf_pattern_matching = true;
 		}
 	| Flash when defined Define.As3 ->
 		{

+ 77 - 1
genneko.ml

@@ -35,6 +35,7 @@ type context = {
 	mutable curclass : string;
 	mutable curmethod : string;
 	mutable inits : (tclass * texpr) list;
+	mutable label_count : int;
 }
 
 let files = Hashtbl.create 0
@@ -419,7 +420,81 @@ and gen_expr ctx e =
 					) (match eo with None -> null p | Some e -> (gen_expr ctx e)) (List.rev cases)
 				],p)
 		)
-	| TPatMatch dt -> assert false
+	| TPatMatch dt ->
+		let lc = ctx.label_count in
+		let get_label i =
+			ctx.label_count <- ctx.label_count + 1;
+			"label_" ^ (string_of_int (lc + i))
+		in
+		let state = Hashtbl.create 0 in
+		Hashtbl.add state "@tmp" true;
+		let rec gen_st st =
+			let p = pos ctx st.st_pos in
+			match st.st_def with
+			| SVar v -> gen_expr ctx (mk (TLocal v) v.v_type st.st_pos)
+			| SField (st,s) -> field p (gen_st st) s
+			| SArray (st,i) -> (EArray (gen_st st,int p i),p)
+			| STuple (st,_,_) -> gen_st st
+			| SEnum (st,_,i) -> (EArray (field p (gen_st st) "args",int p i),p)
+		in
+		let s_con c =
+			let p = pos ctx c.c_pos in
+			match c.c_def with
+			| CEnum (_,ef) -> int p ef.ef_index 
+			| CConst cst -> gen_constant ctx c.c_pos cst
+			| CAny -> assert false
+		in
+		let goto i = call p (builtin p "goto") [ident p (get_label i)] in
+(* 		let goto i = EBlock [
+			call p (builtin p "print") [call p (field p (ident p "String") "new") [gen_big_string ctx p ("goto " ^ (get_label i) ^ "\n")]];			
+			call p (builtin p "goto") [ident p (get_label i)];
+		],p in	 *)	
+		let out = Array.length dt.dt_dt_lookup in
+		let assign_return e =
+			EBlock [
+				(EBinop ("=",ident p "@tmp",e),p);
+				goto out;
+			],p
+		in
+		let rec loop dt = match dt with
+			| Goto i ->
+				goto i
+			| Bind (bl,dt) ->
+				let block = List.map (fun ((v,_),st) -> (EBinop ("=",ident p 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 -> assign_return (gen_expr ctx e)
+					| None,Some _ -> assert false
+				end
+			| Switch (st,cl) ->
+				let est = gen_st st in
+				let e = match st.st_type with
+					| TEnum _ -> field p est "index"
+					| _ -> est
+				in
+				let def = ref None in
+				let cases = ExtList.List.filter_map (fun (c,dt) ->
+					if c.c_def = CAny then begin
+						def := Some (loop dt);
+						None
+					end else
+						Some (s_con c,loop dt)
+				) cl in
+				(ESwitch (e,cases,!def),p)
+		in
+		let i = ref 0 in
+		let var_inits = EVars (List.map (fun (v,eo) -> v.v_name,(match eo with None -> None | Some e -> Some (gen_expr ctx e))) dt.dt_var_init),p in
+		let eout = (ELabel (get_label out),p) :: [ident p "@tmp"] in
+		let inits = Array.fold_left (fun acc dt ->
+			incr i;
+			(ELabel(get_label (!i - 1)),p)
+			:: loop dt
+			:: acc
+		) eout dt.dt_dt_lookup in
+		EBlock (var_inits :: inits),p
 	| TSwitch (e,cases,eo) ->
 		let e = gen_expr ctx e in
 		let eo = (match eo with None -> None | Some e -> Some (gen_expr ctx e)) in
@@ -766,6 +841,7 @@ let new_context com ver macros =
 		curclass = "$boot";
 		curmethod = "$init";
 		inits = [];
+		label_count = 0;
 	}
 
 let header() =

+ 1 - 1
typecore.ml

@@ -291,7 +291,7 @@ let add_local ctx n t =
 	ctx.locals <- PMap.add n v ctx.locals;
 	v
 
-let gen_local_prefix = "`"
+let gen_local_prefix = "_"
 
 let gen_local ctx t =
 	(* ensure that our generated local does not mask an existing one *)

+ 3 - 0
typeload.ml

@@ -886,6 +886,9 @@ let rec return_flow ctx e =
 	| TMatch (_,_,cases,def) ->
 		List.iter (fun (_,_,e) -> return_flow e) cases;
 		(match def with None -> () | Some e -> return_flow e)
+	| TPatMatch _ ->
+		(* TODO *)
+		()
 	| TTry (e,cases) ->
 		return_flow e;
 		List.iter (fun (_,e) -> return_flow e) cases;