diff --git a/src/ast_to_c.ml b/src/ast_to_c.ml index 5756bdb..be8b01b 100644 --- a/src/ast_to_c.ml +++ b/src/ast_to_c.ml @@ -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" diff --git a/src/cprint.ml b/src/cprint.ml index b3e8742..40f02e7 100644 --- a/src/cprint.ml +++ b/src/cprint.ml @@ -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 diff --git a/src/ctranslation.ml b/src/ctranslation.ml index aab6548..c0de7ff 100644 --- a/src/ctranslation.ml +++ b/src/ctranslation.ml @@ -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! diff --git a/src/intermediate_ast.ml b/src/intermediate_ast.ml index 4c520bf..e259596 100644 --- a/src/intermediate_ast.ml +++ b/src/intermediate_ast.ml @@ -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; diff --git a/src/intermediate_utils.ml b/src/intermediate_utils.ml index 26804f8..e136508 100644 --- a/src/intermediate_utils.ml +++ b/src/intermediate_utils.ml @@ -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 diff --git a/src/test.node b/src/test.node new file mode 100644 index 0000000..4e3d799 --- /dev/null +++ b/src/test.node @@ -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