src/cminor/cminorFold.ml

   1
   2 (** This module provides folding functions over the constructors of the
   3     [Cminor]'s AST. *)
   4
   5
   6 let expression_subs (Cminor.Expr (ed, _)) = match ed with
   7   | Cminor.Id _ | Cminor.Cst _ -> []
   8   | Cminor.Op1 (_, e) | Cminor.Mem (_, e) | Cminor.Exp_cost (_, e) -> [e]
   9   | Cminor.Op2 (_, e1, e2) -> [e1 ; e2]
  10   | Cminor.Cond (e1, e2, e3) -> [e1 ; e2 ; e3]
  11
  12 let expression_fill_subs (Cminor.Expr (ed, t)) subs =
  13   let ed = match ed, subs with
  14     | Cminor.Id _, _ | Cminor.Cst _, _ -> ed
  15     | Cminor.Op1 (op1, _), e :: _ -> Cminor.Op1 (op1, e)
  16     | Cminor.Op2 (op2, _, _), e1 :: e2 :: _ -> Cminor.Op2 (op2, e1, e2)
  17     | Cminor.Mem (size, _), e :: _ -> Cminor.Mem (size, e)
  18     | Cminor.Cond _, e1 :: e2 :: e3 :: _ -> Cminor.Cond (e1, e2, e3)
  19     | Cminor.Exp_cost (lbl, _), e :: _ -> Cminor.Exp_cost (lbl, e)
  20     | _ -> assert false (* wrong parameter size *) in
  21   Cminor.Expr (ed, t)
  22
  23
  24 (* In [expression f e], [f]'s second argument is the list of
  25    [expression]'s results on [e]'s sub-expressions. *)
  26
  27 let rec expression f_expr e =
  28   let sub_es_res = List.map (expression f_expr) (expression_subs e) in
  29   f_expr e sub_es_res
  30
  31
  32 let statement_subs = function
  33   | Cminor.St_skip | Cminor.St_exit _ | Cminor.St_return None
  34   | Cminor.St_goto _ -> ([], [])
  35   | Cminor.St_assign (_, e) | Cminor.St_switch (e, _, _)
  36   | Cminor.St_return (Some e) -> ([e], [])
  37   | Cminor.St_store (_, e1, e2) ->
  38     ([e1 ; e2], [])
  39   | Cminor.St_call (_, f, args, _) | Cminor.St_tailcall (f, args, _) ->
  40     (f :: args, [])
  41   | Cminor.St_seq (stmt1, stmt2) ->
  42     ([], [stmt1 ; stmt2])
  43   | Cminor.St_ifthenelse (e, stmt1, stmt2) ->
  44     ([e], [stmt1 ; stmt2])
  45   | Cminor.St_loop stmt | Cminor.St_block stmt
  46   | Cminor.St_label (_, stmt) | Cminor.St_cost (_, stmt) ->
  47     ([], [stmt])
  48
  49 let statement_fill_subs stmt sub_es sub_stmts =
  50   match stmt, sub_es, sub_stmts with
  51     | (  Cminor.St_skip | Cminor.St_exit _ | Cminor.St_return None
  52        | Cminor.St_goto _), _, _ -> stmt
  53     | Cminor.St_assign (x, _), e :: _, _ ->
  54       Cminor.St_assign (x, e)
  55     | Cminor.St_switch (_, cases, dflt), e :: _, _ ->
  56       Cminor.St_switch (e, cases, dflt)
  57     | Cminor.St_return _, e :: _, _ ->
  58       Cminor.St_return (Some e)
  59     | Cminor.St_store (size, _, _), e1 :: e2 :: _, _ ->
  60       Cminor.St_store (size, e1, e2)
  61     | Cminor.St_call (x_opt, _, _, sg), f :: args, _ ->
  62       Cminor.St_call (x_opt, f, args, sg)
  63     | Cminor.St_tailcall (_, _, sg), f :: args, _ ->
  64       Cminor.St_tailcall (f, args, sg)
  65     | Cminor.St_seq _, _, stmt1 :: stmt2 :: _ ->
  66       Cminor.St_seq (stmt1, stmt2)
  67     | Cminor.St_ifthenelse _, e :: _, stmt1 :: stmt2 :: _ ->
  68       Cminor.St_ifthenelse (e, stmt1, stmt2)
  69     | Cminor.St_loop _, _, stmt :: _ ->
  70       Cminor.St_loop stmt
  71     | Cminor.St_block _, _, stmt :: _ ->
  72       Cminor.St_block stmt
  73     | Cminor.St_label (lbl, _), _, stmt :: _ ->
  74       Cminor.St_label (lbl, stmt)
  75     | Cminor.St_cost (lbl, _), _, stmt :: _ ->
  76       Cminor.St_cost (lbl, stmt)
  77     | _ -> assert false (* do not use on these arguments *)
  78
  79 (* In [statement f_expr f_stmt stmt], [f_stmt]'s second argument is the
  80    list of [expression f_expr]'s results on [stmt]'s sub-expressions, and
  81    [f_stmt]'s third argument is the list of [statement]'s results
  82    on [stmt]'s sub-statements. *)
  83
  84 let rec statement f_expr f_stmt stmt =
  85   let (sub_es, sub_stmts) = statement_subs stmt in
  86   let sub_es_res = List.map (expression f_expr) sub_es in
  87   let sub_stmts_res = List.map (statement f_expr f_stmt) sub_stmts in
  88   f_stmt stmt sub_es_res sub_stmts_res