Benjamin_Loison/Synchronous_reactive_systems
1
0
Fork 0
Code Issues 7 Pull Requests Packages Projects Releases Wiki Activity

[ast2C] support for some basic operations (exemple in test.node)

Browse Source
This commit is contained in:
dsac 2022-12-17 23:36:07 +01:00
parent cbc834b32a
commit 7a32d474d4
6 changed files with 78 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/ast_to_c.ml
View File

@ -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
| EVar (_, v) ->
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))
| Some (s, i) -> IEVar (CVStored (s, i))
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
let pre_vars =
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 tyh = Hashtbl.create nb in
let tyh: (ident * bool, int) Hashtbl.t = Hashtbl.create nb in
let i =
List.fold_left
(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
(fun n (v: t_var) ->
match v with
| IVar _ ->
let i = Hashtbl.find h_int (v, false) in
| IVar s ->
let i = Hashtbl.find h_int (s, false) in
Hashtbl.add h_out n ("ivars", i)
| BVar _ ->
let i = Hashtbl.find h_bool (v, false) in
| BVar s ->
let i = Hashtbl.find h_bool (s, false) in
Hashtbl.add h_out n ("bvars", i)
| RVar _ ->
let i = Hashtbl.find h_real (v, false) in
| RVar s ->
let i = Hashtbl.find h_real (s, false) in
Hashtbl.add h_out n ("rvars", i))
(snd node.n_outputs) in
let () = Hashtbl.add h node_name
@ -217,9 +219,9 @@ let cp_prevars fmt (node, h) =
| None ->
let (dst_array, dst_idx) = Hashtbl.find node_st.nt_map (v, true) in
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 ->
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_node] prints a single node *)
@ -284,20 +286,10 @@ let dump_var_locations (st: node_states) =
(fun n st ->
Format.printf "\n\n\tNODE: %s\n" n;
Hashtbl.iter
(fun ((v: t_var), (ispre: bool)) ((arr: string), (idx: int)) ->
match v, ispre with
| IVar s, true -> Format.printf "PRE Variable (int) %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)
(fun (s, (ispre: bool)) ((arr: string), (idx: int)) ->
match ispre with
| true -> Format.printf "PRE Variable %s stored as %s[%d]\n" s arr idx
| false -> Format.printf " Variable %s stored as %s[%d]\n" s arr idx)
st.nt_map)
st;
Format.printf "\n\n"

28
src/cprint.ml
View File

@ -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
| CVariable (CVInput s) -> Format.fprintf fmt "%s" s
| CVariable (CVStored (arr, idx)) ->
Format.fprintf fmt "%s[%d]" arr idx
| CVariable (CVStored (arr, idx)) -> Format.fprintf fmt "%s[%d]" arr idx
| CConst (CInt i) -> Format.fprintf fmt "%d" i
| CConst (CBool true) -> Format.fprintf fmt "true"
| CConst (CBool false) -> Format.fprintf fmt "false"
| CConst (CReal r) -> Format.fprintf fmt "%f" r
(**| CMonOp of monop * c_value
| CBinOp of binop * c_value * c_value
| CComp of compop * c_value * c_value*)
| CMonOp (MOp_not, v) -> Format.fprintf fmt "! (%a)" cp_value (v, hloc)
| CMonOp (MOp_minus, v) -> Format.fprintf fmt "- (%a)" cp_value (v, hloc)
| 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!"
(** The following function prints one transformed equation of the program into a
* set of instruction ending in assignments. *)
let cp_expression fmt (expr, hloc) =
@ -104,7 +116,7 @@ let cp_expression fmt (expr, hloc) =
| CAssign (CVStored (arr, idx), value) ->
begin
Format.fprintf fmt "%s%s[%d] = %a;\n"
prefix arr idx cp_value value
prefix arr idx cp_value (value, hloc)
end
| CAssign (CVInput _, _) -> failwith "should not happend."
(*| CSeq of c_expression * c_expression

29
src/ctranslation.ml
View File

@ -2,14 +2,27 @@ open Ast
open Intermediate_ast
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 () =
match vl with
| [v] ->
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)
| Some (arr, idx) -> CVStored (arr, idx)
end
@ -22,11 +35,13 @@ let equation_to_expression (hloc, ((vl, expr): i_equation)) : c_expression =
CAssign (fetch_unique_var (), CVariable v)
| IEConst c ->
CAssign (fetch_unique_var (), CConst c)
(*| IEMonOp (op, e) ->
CMonOp (op, iexpression_to_cvalue e)
| IEMonOp (op, e) ->
CAssign (fetch_unique_var (),
CMonOp (op, iexpression_to_cvalue e))
| IEBinOp (op, e, e') ->
CBinOp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
| IEComp (op, e, e') ->
CAssign (fetch_unique_var (),
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
TODO!

8
src/intermediate_ast.ml
View File

@ -29,10 +29,10 @@ type node_state =
nt_nb_int : int;
nt_nb_real: int;
nt_nb_bool: int;
nt_map_int: (t_var * bool, int) Hashtbl.t;
nt_map_bool: (t_var * bool, int) Hashtbl.t;
nt_map_real: (t_var * bool, int) Hashtbl.t;
nt_map: (t_var * bool, string * int) Hashtbl.t;
nt_map_int: (ident * bool, int) Hashtbl.t;
nt_map_bool: (ident * bool, int) Hashtbl.t;
nt_map_real: (ident * bool, int) Hashtbl.t;
nt_map: (ident * bool, string * int) Hashtbl.t;
nt_output_map: (int, string * int) Hashtbl.t;
nt_prevars: t_var list;
nt_count_app: int;

8
src/intermediate_utils.ml
View File

@ -40,3 +40,11 @@ let rec find_app_opt eqs i =
match find_app_expr_opt i expr with
| None -> find_app_opt eqs i
| 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
View 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