[ast2C] printer: ok.
This commit is contained in:
parent
ce686f6c9a
commit
1491e279f7
@ -2,6 +2,7 @@ open Ast
|
||||
open Intermediate_ast
|
||||
open Intermediate_utils
|
||||
open Cprint
|
||||
open Cast
|
||||
open Utils
|
||||
open Ctranslation
|
||||
|
||||
@ -254,13 +255,19 @@ let cp_init_aux_nodes fmt (node, h) =
|
||||
|
||||
|
||||
(** [cp_equations] prints the node equations. *)
|
||||
let rec cp_equations fmt (eqs, hloc, h) =
|
||||
match eqs with
|
||||
| [] -> ()
|
||||
| eq :: eqs ->
|
||||
Format.fprintf fmt "%a%a"
|
||||
cp_expression (equation_to_expression (hloc, h, eq), hloc.nt_map)
|
||||
cp_equations (eqs, hloc, h)
|
||||
let cp_equations fmt (eqs, hloc, h) =
|
||||
(** [main_block] is modified through some optimization passes, eg:
|
||||
* - merge two CIf blocks using the same condition
|
||||
* - replace [if (! c) { b1 } else {b2 }] by [if(c) { b2 } else { b1 }]
|
||||
*
|
||||
* These passes are defined in [ctranslation.ml]
|
||||
*)
|
||||
let main_block: c_block =
|
||||
List.map (fun eq -> equation_to_expression (hloc, h, eq)) eqs in
|
||||
let main_block = remove_ifnot main_block in
|
||||
let main_block = merge_neighbour_ifs main_block in
|
||||
Format.fprintf fmt "\t/*Main code :*/\n%a"
|
||||
cp_block (main_block, hloc.nt_map)
|
||||
|
||||
(** [cp_node] prints a single node *)
|
||||
let cp_node fmt (node, h) =
|
||||
|
@ -151,12 +151,13 @@ let prefix_ = ref "\t"
|
||||
|
||||
(** The following function prints one transformed equation of the program into a
|
||||
* set of instruction ending in assignments. *)
|
||||
let rec cp_expression fmt (expr, hloc) =
|
||||
let prefix = !prefix_ in
|
||||
let rec cp_block fmt = function
|
||||
let rec cp_block fmt (b, hloc) =
|
||||
match b with
|
||||
| [] -> ()
|
||||
| e :: b -> Format.fprintf fmt "%a%a" cp_expression (e, hloc) cp_block b
|
||||
in
|
||||
| e :: b ->
|
||||
Format.fprintf fmt "%a%a" cp_expression (e, hloc) cp_block (b, hloc)
|
||||
and cp_expression fmt (expr, hloc) =
|
||||
let prefix = !prefix_ in
|
||||
match expr with
|
||||
| CAssign (CVStored (arr, idx), value) ->
|
||||
begin
|
||||
@ -195,15 +196,18 @@ let rec cp_expression fmt (expr, hloc) =
|
||||
Format.fprintf fmt "%sif (%a) {\n%a%s}\n"
|
||||
p
|
||||
cp_value (v, hloc)
|
||||
cp_block b1
|
||||
cp_block (b1, hloc)
|
||||
p;
|
||||
prefix_ := p
|
||||
| CIf (v, b1, b2) ->
|
||||
let p = prefix in
|
||||
prefix_ := prefix^"\t";
|
||||
Format.fprintf fmt "%sif (%a) {\n%a%s} else {\n%a%s}\n"
|
||||
prefix
|
||||
p
|
||||
cp_value (v, hloc)
|
||||
cp_block b1
|
||||
prefix
|
||||
cp_block b2
|
||||
prefix
|
||||
cp_block (b1, hloc)
|
||||
p
|
||||
cp_block (b2, hloc)
|
||||
p;
|
||||
prefix_ := p
|
||||
|
||||
|
@ -74,8 +74,29 @@ let rec equation_to_expression (node_st, node_sts, (vl, expr)) =
|
||||
[equation_to_expression (node_st, node_sts, (vl, expr))],
|
||||
[])
|
||||
end
|
||||
(*TODO!
|
||||
| IETriOp of triop * i_expression * i_expression * i_expression
|
||||
| IEReset of i_expression * i_expression*)
|
||||
| _ -> failwith "[ctranslation.ml] TODO!"
|
||||
| IETriOp (TOp_if, _, _, _) ->
|
||||
failwith "[ctranslation.ml] A pass should have turned conditionnals into merges."
|
||||
| IETriOp (TOp_merge, c, e, e') ->
|
||||
CIf (iexpression_to_cvalue c,
|
||||
[equation_to_expression (node_st, node_sts, (vl, e))],
|
||||
[equation_to_expression (node_st, node_sts, (vl, e'))])
|
||||
| IEReset _ -> failwith "[ctranslation.ml] A pass should have removed resets."
|
||||
|
||||
|
||||
|
||||
let rec remove_ifnot = function
|
||||
| [] -> []
|
||||
| CIf (CMonOp (MOp_not, c), bh :: bt, b'h :: b't) :: block ->
|
||||
(CIf (c, b'h :: b't, bh :: bt)) :: (remove_ifnot block )
|
||||
| stmt :: block ->
|
||||
stmt :: (remove_ifnot block)
|
||||
|
||||
let rec merge_neighbour_ifs = function
|
||||
| [] -> []
|
||||
| [stmt] -> [stmt]
|
||||
| CIf (c, e1, e2) :: CIf (c', e'1, e'2) :: b ->
|
||||
if c = c'
|
||||
then merge_neighbour_ifs (CIf (c, e1 @ e'1, e2 @ e'2) :: b)
|
||||
else (CIf (c, e1, e2)) :: merge_neighbour_ifs (CIf (c', e'1, e'2) :: b)
|
||||
| stmt :: stmt' :: b ->
|
||||
stmt :: merge_neighbour_ifs (stmt' :: b)
|
||||
|
@ -5,9 +5,11 @@ let
|
||||
tel
|
||||
|
||||
node n (i: int) returns (o1, o2: int);
|
||||
var t1, t2: int; c: bool;
|
||||
var u1, u2, t1, t2: int; c: bool;
|
||||
let
|
||||
c = true -> not pre c;
|
||||
(t1, t2) = aux (i) when c;
|
||||
(o1, o2) = aux (i);
|
||||
(u1, u2) = aux (i) when (not c);
|
||||
o1 = merge c t1 u1;
|
||||
o2 = merge c t2 u2;
|
||||
tel
|
||||
|
Loading…
Reference in New Issue
Block a user