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

missing 'state->' added + print +,-,*,...

Browse Source
This commit is contained in:
dsac 2022-12-17 23:46:39 +01:00
parent 7a32d474d4
commit 233b385608
3 changed files with 22 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/ast_to_c.ml
View File

@ -214,11 +214,11 @@ let cp_prevars fmt (node, h) =
match Hashtbl.find_opt node_st.nt_map (v, false) with match Hashtbl.find_opt node_st.nt_map (v, false) with
| Some (src_array, src_idx) -> | Some (src_array, src_idx) ->
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[%d];\n" Format.fprintf fmt "\tstate->%s[%d] = state->%s[%d];\n"
dst_array dst_idx src_array src_idx dst_array dst_idx src_array src_idx
| 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 "\tstate->%s[%d] = %s;\n"
dst_array dst_idx v dst_array dst_idx v
) )
(List.map Utils.name_of_var l) (List.map Utils.name_of_var l)

23
src/cprint.ml
View File

@ -80,9 +80,19 @@ let rec cp_prototypes fmt ((nodes, h): i_nodelist * node_states) =
let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) = let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) =
let string_of_binop = function
| BOp_add -> "+"
| BOp_sub -> "-"
| BOp_mul -> "*"
| BOp_div -> "/"
| BOp_mod -> "%"
| BOp_and -> "&&"
| BOp_or -> "||"
| BOp_arrow -> failwith "[cprint.ml] string_of_binop undefined on (->)"
in
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)) -> Format.fprintf fmt "%s[%d]" arr idx | CVariable (CVStored (arr, idx)) -> Format.fprintf fmt "state->%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"
@ -99,10 +109,11 @@ let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) =
end end
| CVInput n -> n) in | CVInput n -> n) in
let (arr, idx) = Hashtbl.find hloc (varname, true) in let (arr, idx) = Hashtbl.find hloc (varname, true) in
Format.fprintf fmt "%s[%d]" arr idx Format.fprintf fmt "state->%s[%d]" arr idx
| CBinOp (BOp_add, v, v') -> | CBinOp (BOp_arrow, v, v') -> failwith "[cprint.ml] (->) TODO!"
Format.fprintf fmt "(%a) + (%a)" | CBinOp (op, v, v') ->
cp_value (v, hloc) cp_value (v', hloc) Format.fprintf fmt "(%a) %s (%a)"
cp_value (v, hloc) (string_of_binop op) cp_value (v', hloc)
(**| CComp of compop * c_value * c_value*) (**| CComp of compop * c_value * c_value*)
| _ -> failwith "[cprint.ml] TODO!" | _ -> failwith "[cprint.ml] TODO!"
@ -115,7 +126,7 @@ let cp_expression fmt (expr, hloc) =
match expr with match expr with
| CAssign (CVStored (arr, idx), value) -> | CAssign (CVStored (arr, idx), value) ->
begin begin
Format.fprintf fmt "%s%s[%d] = %a;\n" Format.fprintf fmt "%sstate->%s[%d] = %a;\n"
prefix arr idx cp_value (value, hloc) prefix arr idx cp_value (value, hloc)
end end
| CAssign (CVInput _, _) -> failwith "should not happend." | CAssign (CVInput _, _) -> failwith "should not happend."

4
src/test.node
View File

@ -1,6 +1,8 @@
node n (i: int) returns (o: int); node n (i: int) returns (o: int);
var v, t: int; var v, t: int; a, b: bool;
let let
a = true;
b = a and not (pre a);
o = 1; o = 1;
v = pre o; v = pre o;
t = o + pre i; t = o + pre i;