[ast2C] support for some basic operations (exemple in test.node)
This commit is contained in:
parent
cbc834b32a
commit
7a32d474d4
@ -14,7 +14,7 @@ let ast_to_intermediate_ast (nodes: t_nodelist) (h: node_states): i_nodelist =
|
|||||||
let rec ast_to_intermediate_ast_expr hloc = function
|
let rec ast_to_intermediate_ast_expr hloc = function
|
||||||
| EVar (_, v) ->
|
| EVar (_, v) ->
|
||||||
begin
|
begin
|
||||||
match Hashtbl.find_opt hloc (v, false) with
|
match Hashtbl.find_opt hloc (Utils.name_of_var v, false) with
|
||||||
| None -> IEVar (CVInput (name_of_var v))
|
| None -> IEVar (CVInput (name_of_var v))
|
||||||
| Some (s, i) -> IEVar (CVStored (s, i))
|
| Some (s, i) -> IEVar (CVStored (s, i))
|
||||||
end
|
end
|
||||||
@ -77,8 +77,10 @@ let make_state_types nodes: node_states =
|
|||||||
(snd (varlist_concat (varlist_concat node.n_inputs node.n_outputs) node.n_local_vars)) in
|
(snd (varlist_concat (varlist_concat node.n_inputs node.n_outputs) node.n_local_vars)) in
|
||||||
let pre_vars =
|
let pre_vars =
|
||||||
List.filter (fun v -> List.mem v pv) all_vars in
|
List.filter (fun v -> List.mem v pv) all_vars in
|
||||||
|
let vars = List.map Utils.name_of_var vars in
|
||||||
|
let pre_vars = List.map Utils.name_of_var pre_vars in
|
||||||
let nb = (List.length vars) + (List.length pre_vars) in
|
let nb = (List.length vars) + (List.length pre_vars) in
|
||||||
let tyh = Hashtbl.create nb in
|
let tyh: (ident * bool, int) Hashtbl.t = Hashtbl.create nb in
|
||||||
let i =
|
let i =
|
||||||
List.fold_left
|
List.fold_left
|
||||||
(fun i v -> let () = Hashtbl.add tyh (v, false) i in i + 1) 0 vars in
|
(fun i v -> let () = Hashtbl.add tyh (v, false) i in i + 1) 0 vars in
|
||||||
@ -162,14 +164,14 @@ let make_state_types nodes: node_states =
|
|||||||
let () = List.iteri
|
let () = List.iteri
|
||||||
(fun n (v: t_var) ->
|
(fun n (v: t_var) ->
|
||||||
match v with
|
match v with
|
||||||
| IVar _ ->
|
| IVar s ->
|
||||||
let i = Hashtbl.find h_int (v, false) in
|
let i = Hashtbl.find h_int (s, false) in
|
||||||
Hashtbl.add h_out n ("ivars", i)
|
Hashtbl.add h_out n ("ivars", i)
|
||||||
| BVar _ ->
|
| BVar s ->
|
||||||
let i = Hashtbl.find h_bool (v, false) in
|
let i = Hashtbl.find h_bool (s, false) in
|
||||||
Hashtbl.add h_out n ("bvars", i)
|
Hashtbl.add h_out n ("bvars", i)
|
||||||
| RVar _ ->
|
| RVar s ->
|
||||||
let i = Hashtbl.find h_real (v, false) in
|
let i = Hashtbl.find h_real (s, false) in
|
||||||
Hashtbl.add h_out n ("rvars", i))
|
Hashtbl.add h_out n ("rvars", i))
|
||||||
(snd node.n_outputs) in
|
(snd node.n_outputs) in
|
||||||
let () = Hashtbl.add h node_name
|
let () = Hashtbl.add h node_name
|
||||||
@ -217,9 +219,9 @@ let cp_prevars fmt (node, h) =
|
|||||||
| None ->
|
| None ->
|
||||||
let (dst_array, dst_idx) = Hashtbl.find node_st.nt_map (v, true) in
|
let (dst_array, dst_idx) = Hashtbl.find node_st.nt_map (v, true) in
|
||||||
Format.fprintf fmt "\t%s[%d] = %s;\n"
|
Format.fprintf fmt "\t%s[%d] = %s;\n"
|
||||||
dst_array dst_idx (Utils.name_of_var v)
|
dst_array dst_idx v
|
||||||
)
|
)
|
||||||
l
|
(List.map Utils.name_of_var l)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -257,7 +259,7 @@ let rec cp_equations fmt (eqs, hloc) =
|
|||||||
| [] -> ()
|
| [] -> ()
|
||||||
| eq :: eqs ->
|
| eq :: eqs ->
|
||||||
Format.fprintf fmt "%a%a"
|
Format.fprintf fmt "%a%a"
|
||||||
cp_expression (equation_to_expression (hloc.nt_map, eq), hloc)
|
cp_expression (equation_to_expression (hloc.nt_map, eq), hloc.nt_map)
|
||||||
cp_equations (eqs, hloc)
|
cp_equations (eqs, hloc)
|
||||||
|
|
||||||
(** [cp_node] prints a single node *)
|
(** [cp_node] prints a single node *)
|
||||||
@ -284,20 +286,10 @@ let dump_var_locations (st: node_states) =
|
|||||||
(fun n st ->
|
(fun n st ->
|
||||||
Format.printf "\n\n\tNODE: %s\n" n;
|
Format.printf "\n\n\tNODE: %s\n" n;
|
||||||
Hashtbl.iter
|
Hashtbl.iter
|
||||||
(fun ((v: t_var), (ispre: bool)) ((arr: string), (idx: int)) ->
|
(fun (s, (ispre: bool)) ((arr: string), (idx: int)) ->
|
||||||
match v, ispre with
|
match ispre with
|
||||||
| IVar s, true -> Format.printf "PRE Variable (int) %s stored as %s[%d]\n"
|
| true -> Format.printf "PRE Variable %s stored as %s[%d]\n" s arr idx
|
||||||
s arr idx
|
| false -> Format.printf " Variable %s stored as %s[%d]\n" s arr idx)
|
||||||
| BVar s, true -> Format.printf "PRE Variable (bool) %s stored as %s[%d]\n"
|
|
||||||
s arr idx
|
|
||||||
| RVar s, true -> Format.printf "PRE Variable (real) %s stored as %s[%d]\n"
|
|
||||||
s arr idx
|
|
||||||
| IVar s, false -> Format.printf "Variable (int) %s stored as %s[%d]\n"
|
|
||||||
s arr idx
|
|
||||||
| BVar s, false -> Format.printf "Variable (bool) %s stored as %s[%d]\n"
|
|
||||||
s arr idx
|
|
||||||
| RVar s, false -> Format.printf "Variable (real) %s stored as %s[%d]\n"
|
|
||||||
s arr idx)
|
|
||||||
st.nt_map)
|
st.nt_map)
|
||||||
st;
|
st;
|
||||||
Format.printf "\n\n"
|
Format.printf "\n\n"
|
||||||
|
@ -79,23 +79,35 @@ let rec cp_prototypes fmt ((nodes, h): i_nodelist * node_states) =
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
let cp_value fmt value =
|
let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) =
|
||||||
match value with
|
match value with
|
||||||
| CVariable (CVInput s) -> Format.fprintf fmt "%s" s
|
| CVariable (CVInput s) -> Format.fprintf fmt "%s" s
|
||||||
| CVariable (CVStored (arr, idx)) ->
|
| CVariable (CVStored (arr, idx)) -> Format.fprintf fmt "%s[%d]" arr idx
|
||||||
Format.fprintf fmt "%s[%d]" arr idx
|
|
||||||
| CConst (CInt i) -> Format.fprintf fmt "%d" i
|
| CConst (CInt i) -> Format.fprintf fmt "%d" i
|
||||||
| CConst (CBool true) -> Format.fprintf fmt "true"
|
| CConst (CBool true) -> Format.fprintf fmt "true"
|
||||||
| CConst (CBool false) -> Format.fprintf fmt "false"
|
| CConst (CBool false) -> Format.fprintf fmt "false"
|
||||||
| CConst (CReal r) -> Format.fprintf fmt "%f" r
|
| CConst (CReal r) -> Format.fprintf fmt "%f" r
|
||||||
(**| CMonOp of monop * c_value
|
| CMonOp (MOp_not, v) -> Format.fprintf fmt "! (%a)" cp_value (v, hloc)
|
||||||
| CBinOp of binop * c_value * c_value
|
| CMonOp (MOp_minus, v) -> Format.fprintf fmt "- (%a)" cp_value (v, hloc)
|
||||||
| CComp of compop * c_value * c_value*)
|
| CMonOp (MOp_pre, (CVariable v)) ->
|
||||||
|
let varname = (match v with
|
||||||
|
| CVStored (arr, idx) ->
|
||||||
|
begin
|
||||||
|
match find_varname hloc (arr, idx) with
|
||||||
|
| None -> failwith "[cprint.ml] This varname should be defined."
|
||||||
|
| Some (n, _) -> n
|
||||||
|
end
|
||||||
|
| CVInput n -> n) in
|
||||||
|
let (arr, idx) = Hashtbl.find hloc (varname, true) in
|
||||||
|
Format.fprintf fmt "%s[%d]" arr idx
|
||||||
|
| CBinOp (BOp_add, v, v') ->
|
||||||
|
Format.fprintf fmt "(%a) + (%a)"
|
||||||
|
cp_value (v, hloc) cp_value (v', hloc)
|
||||||
|
(**| CComp of compop * c_value * c_value*)
|
||||||
| _ -> failwith "[cprint.ml] TODO!"
|
| _ -> failwith "[cprint.ml] TODO!"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(** 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 cp_expression fmt (expr, hloc) =
|
let cp_expression fmt (expr, hloc) =
|
||||||
@ -104,7 +116,7 @@ let cp_expression fmt (expr, hloc) =
|
|||||||
| CAssign (CVStored (arr, idx), value) ->
|
| CAssign (CVStored (arr, idx), value) ->
|
||||||
begin
|
begin
|
||||||
Format.fprintf fmt "%s%s[%d] = %a;\n"
|
Format.fprintf fmt "%s%s[%d] = %a;\n"
|
||||||
prefix arr idx cp_value value
|
prefix arr idx cp_value (value, hloc)
|
||||||
end
|
end
|
||||||
| CAssign (CVInput _, _) -> failwith "should not happend."
|
| CAssign (CVInput _, _) -> failwith "should not happend."
|
||||||
(*| CSeq of c_expression * c_expression
|
(*| CSeq of c_expression * c_expression
|
||||||
|
@ -2,14 +2,27 @@ open Ast
|
|||||||
open Intermediate_ast
|
open Intermediate_ast
|
||||||
open Cast
|
open Cast
|
||||||
|
|
||||||
let iexpression_to_cvalue e = ()
|
let rec iexpression_to_cvalue e =
|
||||||
|
match e with
|
||||||
|
| IEVar v -> CVariable v
|
||||||
|
| IEMonOp (op, e) -> CMonOp (op, iexpression_to_cvalue e)
|
||||||
|
| IEBinOp (op, e, e') ->
|
||||||
|
CBinOp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
|
||||||
|
| IEComp (op, e, e') ->
|
||||||
|
CComp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
|
||||||
|
| IEConst c -> CConst c
|
||||||
|
| IEWhen _
|
||||||
|
| IEReset _
|
||||||
|
| IETuple _
|
||||||
|
| IEApp _
|
||||||
|
| IETriOp _ -> failwith "[ctranslation.ml] Should not happened."
|
||||||
|
|
||||||
let equation_to_expression (hloc, ((vl, expr): i_equation)) : c_expression =
|
let equation_to_expression ((hloc: (ident * bool, string * int)Hashtbl.t), ((vl, expr): i_equation)) : c_expression =
|
||||||
let fetch_unique_var () =
|
let fetch_unique_var () =
|
||||||
match vl with
|
match vl with
|
||||||
| [v] ->
|
| [v] ->
|
||||||
begin
|
begin
|
||||||
match Hashtbl.find_opt hloc (v, false) with
|
match Hashtbl.find_opt hloc (Utils.name_of_var v, false) with
|
||||||
| None -> CVInput (Utils.name_of_var v)
|
| None -> CVInput (Utils.name_of_var v)
|
||||||
| Some (arr, idx) -> CVStored (arr, idx)
|
| Some (arr, idx) -> CVStored (arr, idx)
|
||||||
end
|
end
|
||||||
@ -22,11 +35,13 @@ let equation_to_expression (hloc, ((vl, expr): i_equation)) : c_expression =
|
|||||||
CAssign (fetch_unique_var (), CVariable v)
|
CAssign (fetch_unique_var (), CVariable v)
|
||||||
| IEConst c ->
|
| IEConst c ->
|
||||||
CAssign (fetch_unique_var (), CConst c)
|
CAssign (fetch_unique_var (), CConst c)
|
||||||
(*| IEMonOp (op, e) ->
|
| IEMonOp (op, e) ->
|
||||||
CMonOp (op, iexpression_to_cvalue e)
|
CAssign (fetch_unique_var (),
|
||||||
|
CMonOp (op, iexpression_to_cvalue e))
|
||||||
| IEBinOp (op, e, e') ->
|
| IEBinOp (op, e, e') ->
|
||||||
CBinOp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
|
CAssign (fetch_unique_var (),
|
||||||
| IEComp (op, e, e') ->
|
CBinOp (op, iexpression_to_cvalue e, iexpression_to_cvalue e'))
|
||||||
|
(*| IEComp (op, e, e') ->
|
||||||
CComp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
|
CComp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
|
||||||
| IEConst c -> CConst c
|
| IEConst c -> CConst c
|
||||||
TODO!
|
TODO!
|
||||||
|
@ -29,10 +29,10 @@ type node_state =
|
|||||||
nt_nb_int : int;
|
nt_nb_int : int;
|
||||||
nt_nb_real: int;
|
nt_nb_real: int;
|
||||||
nt_nb_bool: int;
|
nt_nb_bool: int;
|
||||||
nt_map_int: (t_var * bool, int) Hashtbl.t;
|
nt_map_int: (ident * bool, int) Hashtbl.t;
|
||||||
nt_map_bool: (t_var * bool, int) Hashtbl.t;
|
nt_map_bool: (ident * bool, int) Hashtbl.t;
|
||||||
nt_map_real: (t_var * bool, int) Hashtbl.t;
|
nt_map_real: (ident * bool, int) Hashtbl.t;
|
||||||
nt_map: (t_var * bool, string * int) Hashtbl.t;
|
nt_map: (ident * bool, string * int) Hashtbl.t;
|
||||||
nt_output_map: (int, string * int) Hashtbl.t;
|
nt_output_map: (int, string * int) Hashtbl.t;
|
||||||
nt_prevars: t_var list;
|
nt_prevars: t_var list;
|
||||||
nt_count_app: int;
|
nt_count_app: int;
|
||||||
|
@ -40,3 +40,11 @@ let rec find_app_opt eqs i =
|
|||||||
match find_app_expr_opt i expr with
|
match find_app_expr_opt i expr with
|
||||||
| None -> find_app_opt eqs i
|
| None -> find_app_opt eqs i
|
||||||
| Some n -> Some n
|
| Some n -> Some n
|
||||||
|
|
||||||
|
let find_varname h v =
|
||||||
|
Hashtbl.fold
|
||||||
|
(fun s e acc ->
|
||||||
|
match acc with
|
||||||
|
| None -> if e = v then Some s else None
|
||||||
|
| Some _ -> acc)
|
||||||
|
h None
|
||||||
|
7
src/test.node
Normal file
7
src/test.node
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
node n (i: int) returns (o: int);
|
||||||
|
var v, t: int;
|
||||||
|
let
|
||||||
|
o = 1;
|
||||||
|
v = pre o;
|
||||||
|
t = o + pre i;
|
||||||
|
tel
|
Loading…
Reference in New Issue
Block a user