Skip to content

Commit

Permalink
removed TMatch (mostly)
Browse files Browse the repository at this point in the history
  • Loading branch information
@Simn
Simn committed Jun 2, 2013
1 parent c9c8974 commit 609abf3
Show file tree
Hide file tree
Showing 17 changed files with 134 additions and 438 deletions.
106 changes: 70 additions & 36 deletions codegen.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -851,18 +851,32 @@ let rec local_usage f e =
local_usage f e;
))
) catchs;
| TMatch (e,_,cases,def) ->
local_usage f e;
List.iter (fun (_,vars,e) ->
let cc f =
(match vars with
| None -> ()
| Some l -> List.iter (function None -> () | Some v -> f (Declare v)) l);
| TPatMatch dt ->
List.iter (fun (v,eo) ->
f (Declare v);
match eo with None -> () | Some e -> local_usage f e
) dt.dt_var_init;
let rec fdt dt = match dt with
| DTBind(bl,dt) ->
List.iter (fun ((v,_),e) ->
f (Declare v);
local_usage f e
) bl;
fdt dt
| DTExpr e -> local_usage f e
| DTGuard(e,dt1,dt2) ->
local_usage f e;
in
f (Block cc)
) cases;
(match def with None -> () | Some e -> local_usage f e);
fdt dt1;
(match dt2 with None -> () | Some dt -> fdt dt)
| DTSwitch(e,cl) ->
local_usage f e;
List.iter (fun (e,dt) ->
local_usage f e;
fdt dt
) cl
| DTGoto _ -> ()
in
Array.iter fdt dt.dt_dt_lookup
| _ ->
iter (local_usage f) e

Expand Down Expand Up @@ -924,7 +938,8 @@ let captured_vars com e =
v, e
) catchs in
mk (TTry (wrap used expr,catchs)) e.etype e.epos
| TMatch (expr,enum,cases,def) ->
(* TODO: find out this does *)
(* | TMatch (expr,enum,cases,def) ->
let cases = List.map (fun (il,vars,e) ->
let pos = e.epos in
let e = ref (wrap used e) in
Expand All @@ -943,7 +958,7 @@ let captured_vars com e =
il, vars, !e
) cases in
let def = match def with None -> None | Some e -> Some (wrap used e) in
mk (TMatch (wrap used expr,enum,cases,def)) e.etype e.epos
mk (TMatch (wrap used expr,enum,cases,def)) e.etype e.epos *)
| TFunction f ->
(*
list variables that are marked as used, but also used in that
Expand Down Expand Up @@ -1176,17 +1191,29 @@ let rename_local_vars com e =
loop e;
old()
) catchs;
| TMatch (e,_,cases,def) ->
loop e;
List.iter (fun (_,vars,e) ->
let old = save() in
(match vars with
| None -> ()
| Some l -> List.iter (function None -> () | Some v -> declare v e.epos) l);
loop e;
old();
) cases;
(match def with None -> () | Some e -> loop e);
| TPatMatch dt ->
let rec fdt dt = match dt with
| DTSwitch(e,cl) ->
loop e;
List.iter (fun (_,dt) ->
let old = save() in
fdt dt;
old();
) cl;
| DTBind(bl,dt) ->
List.iter (fun ((v,p),e) ->
declare v e.epos
) bl;
fdt dt
| DTExpr e -> loop e;
| DTGuard(e,dt1,dt2) ->
loop e;
fdt dt1;
(match dt2 with None -> () | Some dt -> fdt dt)
| DTGoto _ ->
()
in
Array.iter fdt dt.dt_dt_lookup
| TTypeExpr t ->
check t
| TNew (c,_,_) ->
Expand Down Expand Up @@ -1299,17 +1326,24 @@ let check_local_vars_init e =
| Some e ->
loop vars e;
join vars cvars)
| TMatch (e,_,cases,def) ->
loop vars e;
let old = !vars in
let cvars = List.map (fun (_,vl,e) ->
vars := old;
loop vars e;
restore vars old [];
!vars
) cases in
(match def with None -> () | Some e -> vars := old; loop vars e);
join vars cvars
| TPatMatch dt ->
let cvars = ref [] in
let rec fdt dt = match dt with
| DTExpr e ->
let old = !vars in
loop vars e;
restore vars old [];
cvars := !vars :: !cvars
| DTSwitch(e,cl) ->
loop vars e;
List.iter (fun (_,dt) -> fdt dt) cl
| DTGuard(e,dt1,dt2) ->
fdt dt1;
(match dt2 with None -> () | Some dt -> fdt dt)
| DTBind(_,dt) -> fdt dt
| DTGoto _ -> ()
in
join vars !cvars
(* mark all reachable vars as initialized, since we don't exit the block *)
| TBreak | TContinue | TReturn None ->
vars := PMap.map (fun _ -> true) !vars
Expand Down Expand Up @@ -1985,7 +2019,7 @@ let rec constructor_side_effects e =
true
| TField (_,FEnum _) ->
false
| TUnop _ | TArray _ | TField _ | TCall _ | TNew _ | TFor _ | TWhile _ | TSwitch _ | TMatch _ | TPatMatch _ | TReturn _ | TThrow _ ->
| TUnop _ | TArray _ | TField _ | TCall _ | TNew _ | TFor _ | TWhile _ | TSwitch _ | TPatMatch _ | TReturn _ | TThrow _ ->
true
| TBinop _ | TTry _ | TIf _ | TBlock _ | TVars _
| TFunction _ | TArrayDecl _ | TObjectDecl _
Expand Down
2 changes: 1 addition & 1 deletion common.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -484,7 +484,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 ->
{
Expand Down
52 changes: 1 addition & 51 deletions genas3.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -276,7 +276,7 @@ let rec type_str ctx t p =
let rec iter_switch_break in_switch e =
match e.eexpr with
| TFunction _ | TWhile _ | TFor _ -> ()
| TSwitch _ | TMatch _ when not in_switch -> iter_switch_break true e
| TSwitch _ | TPatMatch _ when not in_switch -> iter_switch_break true e
| TBreak when in_switch -> raise Exit
| _ -> iter (iter_switch_break in_switch) e

Expand Down Expand Up @@ -726,49 +726,6 @@ and gen_expr ctx e =
print ctx "catch( %s : %s )" (s_ident v.v_name) (type_str ctx v.v_type e.epos);
gen_expr ctx e;
) catchs;
| TMatch (e,_,cases,def) ->
print ctx "{";
let bend = open_block ctx in
newline ctx;
let tmp = gen_local ctx "$e" in
print ctx "var %s : enum = " tmp;
gen_value ctx e;
newline ctx;
print ctx "switch( %s.index ) {" tmp;
List.iter (fun (cl,params,e) ->
List.iter (fun c ->
newline ctx;
print ctx "case %d:" c;
) cl;
(match params with
| None | Some [] -> ()
| Some l ->
let n = ref (-1) in
let l = List.fold_left (fun acc v -> incr n; match v with None -> acc | Some v -> (v,!n) :: acc) [] l in
match l with
| [] -> ()
| l ->
newline ctx;
spr ctx "var ";
concat ctx ", " (fun (v,n) ->
print ctx "%s : %s = %s.params[%d]" (s_ident v.v_name) (type_str ctx v.v_type e.epos) tmp n;
) l);
gen_block ctx e;
print ctx "break";
) cases;
(match def with
| None -> ()
| Some e ->
newline ctx;
spr ctx "default:";
gen_block ctx e;
print ctx "break";
);
newline ctx;
spr ctx "}";
bend();
newline ctx;
spr ctx "}";
| TPatMatch dt -> assert false
| TSwitch (e,cases,def) ->
spr ctx "switch";
Expand Down Expand Up @@ -931,13 +888,6 @@ and gen_value ctx e =
match def with None -> None | Some e -> Some (assign e)
)) e.etype e.epos);
v()
| TMatch (cond,enum,cases,def) ->
let v = value true in
gen_expr ctx (mk (TMatch (cond,enum,
List.map (fun (constr,params,e) -> (constr,params,assign e)) cases,
match def with None -> None | Some e -> Some (assign e)
)) e.etype e.epos);
v()
| TPatMatch dt -> assert false
| TTry (b,catchs) ->
let v = value true in
Expand Down
70 changes: 16 additions & 54 deletions gencommon.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,7 @@ struct
let mk_heexpr = function
| TConst _ -> 0 | TLocal _ -> 1 | TArray _ -> 3 | TBinop _ -> 4 | TField _ -> 5 | TTypeExpr _ -> 7 | TParenthesis _ -> 8 | TObjectDecl _ -> 9
| TArrayDecl _ -> 10 | TCall _ -> 11 | TNew _ -> 12 | TUnop _ -> 13 | TFunction _ -> 14 | TVars _ -> 15 | TBlock _ -> 16 | TFor _ -> 17 | TIf _ -> 18 | TWhile _ -> 19
| TSwitch _ -> 20 | TMatch _ -> 21 | TTry _ -> 22 | TReturn _ -> 23 | TBreak -> 24 | TContinue -> 25 | TThrow _ -> 26 | TCast _ -> 27 | TMeta _ -> 28 | TPatMatch _ -> 29
| TSwitch _ -> 20 | TPatMatch _ -> 21 | TTry _ -> 22 | TReturn _ -> 23 | TBreak -> 24 | TContinue -> 25 | TThrow _ -> 26 | TCast _ -> 27 | TMeta _ -> 28

let mk_heetype = function
| TMono _ -> 0 | TEnum _ -> 1 | TInst _ -> 2 | TType _ -> 3 | TFun _ -> 4
Expand Down Expand Up @@ -4602,8 +4602,8 @@ struct
{ expr with eexpr = TWhile(fn cond, block, flag) }
| TSwitch(cond, el_block_l, default) ->
{ expr with eexpr = TSwitch( fn cond, List.map (fun (el,block) -> (List.map fn el, block)) el_block_l, default ) }
| TMatch(cond, enum, cases, default) ->
{ expr with eexpr = TMatch(fn cond, enum, cases, default) }
(* | TMatch(cond, enum, cases, default) ->
{ expr with eexpr = TMatch(fn cond, enum, cases, default) } *)
| TReturn(eopt) ->
{ expr with eexpr = TReturn(Option.map fn eopt) }
| TThrow (texpr) ->
Expand Down Expand Up @@ -4669,7 +4669,6 @@ struct
| TFor _
| TWhile _
| TSwitch _
| TMatch _
| TPatMatch _
| TTry _
| TReturn _
Expand Down Expand Up @@ -4795,8 +4794,8 @@ struct
{ right with eexpr = TBlock(apply_assign_block assign_fun el) }
| TSwitch (cond, elblock_l, default) ->
{ right with eexpr = TSwitch(cond, List.map (fun (el,block) -> (el, mk_get_block assign_fun block)) elblock_l, Option.map (mk_get_block assign_fun) default) }
| TMatch (cond, ep, il_vlo_e_l, default) ->
{ right with eexpr = TMatch(cond, ep, List.map (fun (il,vlo,e) -> (il,vlo,mk_get_block assign_fun e)) il_vlo_e_l, Option.map (mk_get_block assign_fun) default) }
(* | TMatch (cond, ep, il_vlo_e_l, default) ->
{ right with eexpr = TMatch(cond, ep, List.map (fun (il,vlo,e) -> (il,vlo,mk_get_block assign_fun e)) il_vlo_e_l, Option.map (mk_get_block assign_fun) default) } *)
| TTry (block, catches) ->
{ right with eexpr = TTry(mk_get_block assign_fun block, List.map (fun (v,block) -> (v,mk_get_block assign_fun block) ) catches) }
| TIf (cond,eif,eelse) ->
Expand Down Expand Up @@ -5103,8 +5102,8 @@ struct
{ e with eexpr = TBlock(block) }
| TTry (block, catches) ->
{ e with eexpr = TTry(traverse (mk_block block), List.map (fun (v,block) -> (v, traverse (mk_block block))) catches) }
| TMatch (cond,ep,il_vol_e_l,default) ->
{ e with eexpr = TMatch(cond,ep,List.map (fun (il,vol,e) -> (il,vol,traverse (mk_block e))) il_vol_e_l, Option.map (fun e -> traverse (mk_block e)) default) }
(* | TMatch (cond,ep,il_vol_e_l,default) ->
{ e with eexpr = TMatch(cond,ep,List.map (fun (il,vol,e) -> (il,vol,traverse (mk_block e))) il_vol_e_l, Option.map (fun e -> traverse (mk_block e)) default) } *)
| TSwitch (cond,el_e_l, default) ->
{ e with eexpr = TSwitch(cond, List.map (fun (el,e) -> (el, traverse (mk_block e))) el_e_l, Option.map (fun e -> traverse (mk_block e)) default) }
| TWhile (cond,block,flag) ->
Expand Down Expand Up @@ -6010,8 +6009,8 @@ struct
{ e with eexpr = TWhile (handle (run econd) gen.gcon.basic.tbool econd.etype, run (mk_block e1), flag) }
| TSwitch (cond, el_e_l, edef) ->
{ e with eexpr = TSwitch(run cond, List.map (fun (el,e) -> (List.map run el, run (mk_block e))) el_e_l, Option.map (fun e -> run (mk_block e)) edef) }
| TMatch (cond, en, il_vl_e_l, edef) ->
{ e with eexpr = TMatch(run cond, en, List.map (fun (il, vl, e) -> (il, vl, run (mk_block e))) il_vl_e_l, Option.map (fun e -> run (mk_block e)) edef) }
(* | TMatch (cond, en, il_vl_e_l, edef) ->
{ e with eexpr = TMatch(run cond, en, List.map (fun (il, vl, e) -> (il, vl, run (mk_block e))) il_vl_e_l, Option.map (fun e -> run (mk_block e)) edef) } *)
| TFor (v,cond,e1) ->
{ e with eexpr = TFor(v, run cond, run (mk_block e1)) }
| TTry (e, ve_l) ->
Expand Down Expand Up @@ -8600,43 +8599,6 @@ struct
in
let cond_array = { (mk_field_access gen f "params" f.epos) with etype = gen.gcon.basic.tarray t_empty } in
{ e with eexpr = TArray(cond_array, mk_int gen i cond_array.epos); }
| TMatch(cond,(en,eparams),cases,default) ->
let cond = run cond in (* being safe *)
(* check if en was converted to class *)
(* if it was, switch on tag field and change cond type *)
let exprs_before, cond_local, cond = try
let cl = Hashtbl.find t.ec_tbl en.e_path in
let cond = { cond with etype = TInst(cl, eparams) } in
let exprs_before, new_cond = ensure_local gen cond in
exprs_before, new_cond, get_index gen new_cond cl eparams
with | Not_found ->
(*
if it's not a class, we'll either use get_native_enum_tag or in a last resource,
call Type.getEnumIndex
*)
match opt_get_native_enum_tag with
| Some get_native_etag ->
[], cond, get_native_etag cond
| None ->
[], cond, { eexpr = TCall(mk_static_field_access_infer gen.gclasses.cl_type "enumIndex" e.epos [], [cond]); etype = gen.gcon.basic.tint; epos = cond.epos }
in

(* for each case, change cases to expr int, and see if there is any var create *)
let change_case (il, params, expr) =
let expr = run expr in
(* if there are, set var with tarray *)
let exprs = tmatch_params_to_exprs gen params cond_local in
let expr = match expr.eexpr with
| TBlock(bl) -> { expr with eexpr = TBlock(exprs @ bl) }
| _ -> { expr with eexpr = TBlock ( exprs @ [expr] ) }
in
(List.map (fun i -> mk_int gen i e.epos) il, expr)
in

let tswitch = { e with eexpr = TSwitch(cond, List.map change_case cases, Option.map run default) } in
(match exprs_before with
| [] -> tswitch
| _ -> { e with eexpr = TBlock(exprs_before @ [tswitch]) })
| _ -> Type.map_expr run e
in

Expand Down Expand Up @@ -9350,7 +9312,7 @@ struct

new_e
| TSwitch _
| TMatch _ ->
| TPatMatch _ ->
let last_switch = !in_switch in
in_switch := true;

Expand Down Expand Up @@ -9574,9 +9536,9 @@ struct
(el, handle_case (e, ek))
) el_e_l, Some def) } in
ret, !k
| TMatch(cond, ep, il_vopt_e_l, None) ->
{ expr with eexpr = TMatch(cond, ep, List.map (fun (il, vopt, e) -> (il, vopt, handle_case (process_expr e))) il_vopt_e_l, None) }, Normal
| TMatch(cond, ep, il_vopt_e_l, Some def) ->
(* | TMatch(cond, ep, il_vopt_e_l, None) ->
{ expr with eexpr = TMatch(cond, ep, List.map (fun (il, vopt, e) -> (il, vopt, handle_case (process_expr e))) il_vopt_e_l, None) }, Normal *)
(* | TMatch(cond, ep, il_vopt_e_l, Some def) ->
let def, k = process_expr def in
let def = handle_case (def, k) in
let k = ref k in
Expand All @@ -9585,7 +9547,7 @@ struct
k := aggregate_kind !k ek;
(il, vopt, handle_case (e, ek))
) il_vopt_e_l, Some def) } in
ret, !k
ret, !k *)
| TTry (e, catches) ->
let e, k = process_expr e in
let k = ref k in
Expand Down Expand Up @@ -9866,8 +9828,8 @@ struct
{ e with eexpr = TBlock bl }
| TTry (block, catches) ->
{ e with eexpr = TTry(traverse (mk_block block), List.map (fun (v,block) -> (v, traverse (mk_block block))) catches) }
| TMatch (cond,ep,il_vol_e_l,default) ->
{ e with eexpr = TMatch(cond,ep,List.map (fun (il,vol,e) -> (il,vol,traverse (mk_block e))) il_vol_e_l, Option.map (fun e -> traverse (mk_block e)) default) }
(* | TMatch (cond,ep,il_vol_e_l,default) ->
{ e with eexpr = TMatch(cond,ep,List.map (fun (il,vol,e) -> (il,vol,traverse (mk_block e))) il_vol_e_l, Option.map (fun e -> traverse (mk_block e)) default) } *)
| TSwitch (cond,el_e_l, default) ->
{ e with eexpr = TSwitch(cond, List.map (fun (el,e) -> (el, traverse (mk_block e))) el_e_l, Option.map (fun e -> traverse (mk_block e)) default) }
| TWhile (cond,block,flag) ->
Expand Down
Loading

0 comments on commit 609abf3

Please sign in to comment.