source: Deliverables/D2.2/8051/src/cminor/cminorFold.ml @ 740

(** 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