(** This module provides folding functions over the constructors of the
[Cminor]'s AST. *)
(* Left operators *)
(* In [expression_left f e], [f]'s second argument is the list of
[expression_left]'s results on [e]'s sub-expressions. The results are
computed from left to right following their appearance order in the
[Cminor.expression] type. *)
let rec expression_left f_expr e =
let subexpr_res = match e with
| Cminor.Id _ | Cminor.Cst _ -> []
| Cminor.Op1 (_, e) | Cminor.Mem (_, e) | Cminor.Exp_cost (_, e) ->
[expression_left f_expr e]
| Cminor.Op2 (_, e1, e2) ->
let res1 = expression_left f_expr e1 in
let res2 = expression_left f_expr e2 in
[res1 ; res2]
| Cminor.Cond (e1, e2, e3) ->
let res1 = expression_left f_expr e1 in
let res2 = expression_left f_expr e2 in
let res3 = expression_left f_expr e3 in
[res1 ; res2 ; res3]
in
f_expr e subexpr_res
let map_left f =
let rec aux = function
| [] -> []
| e :: l -> let x = f e in x :: (aux l)
in
aux
(* In [statement_left f_expr f_stmt stmt], [f_stmt]'s second argument is the
list of [expression_left f_expr]'s results on [stmt]'s sub-expressions, and
[f_stmt]'s third argument is the list of [statement_left]'s results
on [stmt]'s sub-statements. The results are computed from left to right
following their appearance order in the [Cminor.statement] type. *)
let rec statement_left f_expr f_stmt stmt =
let expr_res e = expression_left f_expr e in
let (subexpr_res, substmt_res) = match stmt with
| Cminor.St_skip | Cminor.St_exit _ | Cminor.St_switch _
| Cminor.St_return None | Cminor.St_goto _ -> ([], [])
| Cminor.St_assign (_, e) | Cminor.St_return (Some e) -> ([expr_res e], [])
| Cminor.St_store (_, e1, e2) ->
let res1 = expr_res e1 in
let res2 = expr_res e2 in
([res1 ; res2], [])
| Cminor.St_call (_, f, args, _) | Cminor.St_tailcall (f, args, _) ->
let resf = expr_res f in
let resargs = map_left expr_res args in
(resf :: resargs, [])
| Cminor.St_seq (stmt1, stmt2) ->
let res1 = statement_left f_expr f_stmt stmt1 in
let res2 = statement_left f_expr f_stmt stmt2 in
([], [res1 ; res2])
| Cminor.St_ifthenelse (e, stmt1, stmt2) ->
let rese = expr_res e in
let res1 = statement_left f_expr f_stmt stmt1 in
let res2 = statement_left f_expr f_stmt stmt2 in
([rese], [res1 ; res2])
| Cminor.St_loop stmt | Cminor.St_block stmt
| Cminor.St_label (_, stmt) | Cminor.St_cost (_, stmt) ->
([], [statement_left f_expr f_stmt stmt])
in
f_stmt stmt subexpr_res substmt_res
(* Right operators *)
(* In [expression_right f e], [f]'s second argument is the list of
[expression_right]'s results on [e]'s sub-expressions. The results are
computed from right to left following their appearance order in the
[Cminor.expression] type. *)
let rec expression_right f_expr e =
let subexpr_res = match e with
| Cminor.Id _ | Cminor.Cst _ -> []
| Cminor.Op1 (_, e) | Cminor.Mem (_, e) | Cminor.Exp_cost (_, e) ->
[expression_right f_expr e]
| Cminor.Op2 (_, e1, e2) ->
let res2 = expression_right f_expr e2 in
let res1 = expression_right f_expr e1 in
[res2 ; res1]
| Cminor.Cond (e1, e2, e3) ->
let res3 = expression_right f_expr e3 in
let res2 = expression_right f_expr e2 in
let res1 = expression_right f_expr e1 in
[res3 ; res2 ; res1]
in
f_expr subexpr_res e
let map_right f =
let rec aux = function
| [] -> []
| e :: l -> let res = (aux l) in (f e) :: res
in
aux
(* In [statement_right f_expr f_stmt stmt], [f_stmt]'s second argument is the
list of [expression_left f_expr]'s results on [stmt]'s sub-expressions, and
[f_stmt]'s third argument is the list of [statement_left]'s results
on [stmt]'s sub-statements. The results are computed from right to left
following their appearance order in the [Cminor.statement] type. *)
let rec statement_right f_expr f_stmt stmt =
let expr_res e = expression_right f_expr e in
let (subexpr_res, substmt_res) = match stmt with
| Cminor.St_skip | Cminor.St_exit _ | Cminor.St_switch _
| Cminor.St_return None | Cminor.St_goto _ -> ([], [])
| Cminor.St_assign (_, e) | Cminor.St_return (Some e) -> ([expr_res e], [])
| Cminor.St_store (_, e1, e2) ->
let res2 = expr_res e2 in
let res1 = expr_res e1 in
([res2 ; res1], [])
| Cminor.St_call (_, f, args, _) | Cminor.St_tailcall (f, args, _) ->
let resargs = map_right expr_res args in
let resf = expr_res f in
(resargs @ [resf], [])
| Cminor.St_seq (stmt1, stmt2) ->
let res2 = statement_right f_expr f_stmt stmt2 in
let res1 = statement_right f_expr f_stmt stmt1 in
([], [res2 ; res1])
| Cminor.St_ifthenelse (e, stmt1, stmt2) ->
let res2 = statement_right f_expr f_stmt stmt2 in
let res1 = statement_right f_expr f_stmt stmt1 in
let rese = expr_res e in
([rese], [res2 ; res1])
| Cminor.St_loop stmt | Cminor.St_block stmt
| Cminor.St_label (_, stmt) | Cminor.St_cost (_, stmt) ->
([], [statement_right f_expr f_stmt stmt])
in
f_stmt subexpr_res substmt_res stmt