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