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

[general] renaming: done.

Browse Source
This commit is contained in:
dsac 2022-12-17 21:37:37 +01:00
parent 3cbfaeb2a8
commit a877501cca
4 changed files with 59 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
src/ast_to_c.ml
View File

@ -6,40 +6,40 @@ open Utils
(** [ast_to_cast] translates a [t_nodelist] into a [c_nodelist] *) (** [ast_to_cast] translates a [t_nodelist] into a [i_nodelist] *)
let ast_to_cast (nodes: t_nodelist) (h: node_states): c_nodelist = let ast_to_cast (nodes: t_nodelist) (h: node_states): i_nodelist =
let c = ref 1 in let c = ref 1 in
let ast_to_cast_varlist vl = snd vl in let ast_to_cast_varlist vl = snd vl in
let rec ast_to_cast_expr hloc = function let rec ast_to_cast_expr hloc = function
| EVar (_, v) -> | EVar (_, v) ->
begin begin
match Hashtbl.find_opt hloc (v, false) with match Hashtbl.find_opt hloc (v, false) with
| None -> CVar (CVInput (name_of_var v)) | None -> IVar (CVInput (name_of_var v))
| Some (s, i) -> CVar (CVStored (s, i)) | Some (s, i) -> IVar (CVStored (s, i))
end end
| EMonOp (_, op, e) -> CMonOp (op, ast_to_cast_expr hloc e) | EMonOp (_, op, e) -> IMonOp (op, ast_to_cast_expr hloc e)
| EBinOp (_, op, e, e') -> | EBinOp (_, op, e, e') ->
CBinOp (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e') IBinOp (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e')
| ETriOp (_, op, e, e', e'') -> | ETriOp (_, op, e, e', e'') ->
CTriOp ITriOp
(op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e', ast_to_cast_expr hloc e'') (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e', ast_to_cast_expr hloc e'')
| EComp (_, op, e, e') -> | EComp (_, op, e, e') ->
CComp (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e') IComp (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e')
| EWhen (_, e, e') -> | EWhen (_, e, e') ->
CWhen (ast_to_cast_expr hloc e, ast_to_cast_expr hloc e') IWhen (ast_to_cast_expr hloc e, ast_to_cast_expr hloc e')
| EReset (_, e, e') -> | EReset (_, e, e') ->
CReset (ast_to_cast_expr hloc e, ast_to_cast_expr hloc e') IReset (ast_to_cast_expr hloc e, ast_to_cast_expr hloc e')
| EConst (_, c) -> CConst c | EConst (_, c) -> IConst c
| ETuple (_, l) -> CTuple (List.map (ast_to_cast_expr hloc) l) | ETuple (_, l) -> ITuple (List.map (ast_to_cast_expr hloc) l)
| EApp (_, n, e) -> | EApp (_, n, e) ->
begin begin
let e = ast_to_cast_expr hloc e in let e = ast_to_cast_expr hloc e in
let res = CApp (!c, n, e) in let res = IApp (!c, n, e) in
let () = incr c in let () = incr c in
res res
end end
in in
let ast_to_cast_eq hloc (patt, expr) : c_equation = let ast_to_cast_eq hloc (patt, expr) : i_equation =
(ast_to_cast_varlist patt, ast_to_cast_expr hloc expr) in (ast_to_cast_varlist patt, ast_to_cast_expr hloc expr) in
List.map List.map
begin begin
@ -47,11 +47,11 @@ let ast_to_cast (nodes: t_nodelist) (h: node_states): c_nodelist =
let () = c := 1 in let () = c := 1 in
let hloc = (Hashtbl.find h node.n_name).nt_map in let hloc = (Hashtbl.find h node.n_name).nt_map in
{ {
cn_name = node.n_name; in_name = node.n_name;
cn_inputs = ast_to_cast_varlist node.n_inputs; in_inputs = ast_to_cast_varlist node.n_inputs;
cn_outputs = ast_to_cast_varlist node.n_outputs; in_outputs = ast_to_cast_varlist node.n_outputs;
cn_local_vars = ast_to_cast_varlist node.n_local_vars; in_local_vars = ast_to_cast_varlist node.n_local_vars;
cn_equations = List.map (ast_to_cast_eq hloc) node.n_equations; in_equations = List.map (ast_to_cast_eq hloc) node.n_equations;
} }
end end
nodes nodes
@ -156,7 +156,7 @@ let make_state_types nodes: node_states =
let node_out_vars = snd node.n_outputs in let node_out_vars = snd node.n_outputs in
let h_out = Hashtbl.create (List.length node_out_vars) in let h_out = Hashtbl.create (List.length node_out_vars) in
let () = List.iteri let () = List.iteri
(fun n v -> (fun n (v: t_var) ->
match v with match v with
| IVar _ -> | IVar _ ->
let i = Hashtbl.find h_int (v, false) in let i = Hashtbl.find h_int (v, false) in
@ -197,8 +197,8 @@ let make_state_types nodes: node_states =
(** The following function prints the code to remember previous values of (** The following function prints the code to remember previous values of
* variables used with the pre construct. *) * variables used with the pre construct. *)
let cp_prevars fmt (node, h) = let cp_prevars fmt (node, h) =
let node_st = Hashtbl.find h node.cn_name in let node_st = Hashtbl.find h node.in_name in
match (Hashtbl.find h node.cn_name).nt_prevars with match (Hashtbl.find h node.in_name).nt_prevars with
| [] -> () | [] -> ()
| l -> | l ->
Format.fprintf fmt Format.fprintf fmt
@ -219,7 +219,7 @@ let cp_prevars fmt (node, h) =
*) *)
let cp_init_aux_nodes fmt (node, h) = let cp_init_aux_nodes fmt (node, h) =
let rec aux fmt (node, nst, i) = let rec aux fmt (node, nst, i) =
match find_app_opt node.cn_equations i with match find_app_opt node.in_equations i with
| None -> () (** All auxiliary nodes have been initialized *) | None -> () (** All auxiliary nodes have been initialized *)
| Some n -> | Some n ->
begin begin
@ -230,7 +230,7 @@ let cp_init_aux_nodes fmt (node, h) =
(Format.asprintf "t_state_%s" n.n_name) (i-1) (Format.asprintf "t_state_%s" n.n_name) (i-1)
end end
in in
let nst = Hashtbl.find h node.cn_name in let nst = Hashtbl.find h node.in_name in
if nst.nt_count_app = 0 if nst.nt_count_app = 0
then () then ()
else begin else begin
@ -262,7 +262,7 @@ let cp_node fmt (node, h) =
Format.fprintf fmt "%a\n{\n%a%a\n\n\tstate->is_init = false;\n%a}\n" Format.fprintf fmt "%a\n{\n%a%a\n\n\tstate->is_init = false;\n%a}\n"
cp_prototype (node, h) cp_prototype (node, h)
cp_init_aux_nodes (node, h) cp_init_aux_nodes (node, h)
cp_equations (node.cn_equations, Hashtbl.find h node.cn_name) cp_equations (node.in_equations, Hashtbl.find h node.in_name)
cp_prevars (node, h) cp_prevars (node, h)
(** [cp_nodes] recursively prints all the nodes of a program. *) (** [cp_nodes] recursively prints all the nodes of a program. *)
@ -279,7 +279,7 @@ let rec cp_nodes fmt (nodes, h) =
(** main function that prints a C-code from a term of type [t_nodelist]. *) (** main function that prints a C-code from a term of type [t_nodelist]. *)
let ast_to_c prog = let ast_to_c prog =
let prog_st_types = make_state_types prog in let prog_st_types = make_state_types prog in
let prog: c_nodelist = ast_to_cast prog prog_st_types in let prog: i_nodelist = ast_to_cast prog prog_st_types in
Format.printf "%a\n\n%a\n\n/* Node Prototypes: */\n%a\n\n/* Nodes: */\n%a" Format.printf "%a\n\n%a\n\n/* Node Prototypes: */\n%a\n\n/* Nodes: */\n%a"
cp_includes (Config.c_includes) cp_includes (Config.c_includes)
cp_state_types prog_st_types cp_state_types prog_st_types

10
src/cprint.ml
View File

@ -7,7 +7,7 @@ open Ast
let rec cp_includes fmt = function let rec cp_includes fmt = function
| [] -> () | [] -> ()
| h :: t -> | h :: t ->
Format.fprintf fmt "#include <%s>\n%a" h cp_includes t Format.fprintf fmt "#include <%s.h>\n%a" h cp_includes t
let cp_node_state fmt (st: node_state) = let cp_node_state fmt (st: node_state) =
let maybeprint fmt (ty, nb, name): unit = let maybeprint fmt (ty, nb, name): unit =
@ -58,17 +58,17 @@ let rec cp_varlist fmt vl =
cp_varlist vl cp_varlist vl
let cp_prototype fmt (node, h): unit = let cp_prototype fmt (node, h): unit =
match Hashtbl.find_opt h node.cn_name with match Hashtbl.find_opt h node.in_name with
| None -> failwith "This should not happend!" | None -> failwith "This should not happend!"
| Some nst -> | Some nst ->
begin begin
Format.fprintf fmt "void fn_%s (%s *state, %a)" Format.fprintf fmt "void fn_%s (%s *state, %a)"
node.cn_name node.in_name
nst.nt_name nst.nt_name
cp_varlist node.cn_inputs cp_varlist node.in_inputs
end end
let rec cp_prototypes fmt ((nodes, h): c_nodelist * node_states) = let rec cp_prototypes fmt ((nodes, h): i_nodelist * node_states) =
match nodes with match nodes with
| [] -> () | [] -> ()
| node :: nodes -> | node :: nodes ->

42
src/intermediate_ast.ml
View File

@ -44,35 +44,35 @@ type c_var =
| CVStored of string * int | CVStored of string * int
| CVInput of ident | CVInput of ident
type c_expression = type i_expression =
| CVar of c_var | IVar of c_var
| CMonOp of monop * c_expression | IMonOp of monop * i_expression
| CBinOp of binop * c_expression * c_expression | IBinOp of binop * i_expression * i_expression
| CTriOp of triop * c_expression * c_expression * c_expression | ITriOp of triop * i_expression * i_expression * i_expression
| CComp of compop * c_expression * c_expression | IComp of compop * i_expression * i_expression
| CWhen of c_expression * c_expression | IWhen of i_expression * i_expression
| CReset of c_expression * c_expression | IReset of i_expression * i_expression
| CConst of const | IConst of const
| CTuple of (c_expression list) | ITuple of (i_expression list)
(** [CApp] below represents the n-th call to an aux node *) (** [CApp] below represents the n-th call to an aux node *)
| CApp of int * t_node * c_expression | IApp of int * t_node * i_expression
and c_varlist = t_var list and i_varlist = t_var list
and c_equation = c_varlist * c_expression and i_equation = i_varlist * i_expression
and c_eqlist = c_equation list and i_eqlist = i_equation list
and c_node = and i_node =
{ {
cn_name : ident; in_name : ident;
cn_inputs: c_varlist; in_inputs: i_varlist;
cn_outputs: c_varlist; in_outputs: i_varlist;
cn_local_vars: c_varlist; in_local_vars: i_varlist;
cn_equations: c_eqlist; in_equations: i_eqlist;
} }
type c_nodelist = c_node list type i_nodelist = i_node list
type node_states = (ident, node_state) Hashtbl.t type node_states = (ident, node_state) Hashtbl.t

14
src/intermediate_utils.ml
View File

@ -2,15 +2,15 @@ open Intermediate_ast
let rec find_app_opt eqs i = let rec find_app_opt eqs i =
let rec find_app_expr_opt i = function let rec find_app_expr_opt i = function
| CVar _ | CConst _ -> None | IVar _ | IConst _ -> None
| CMonOp (_, e) -> find_app_expr_opt i e | IMonOp (_, e) -> find_app_expr_opt i e
| CReset (e, e') | CWhen (e, e') | CComp (_, e, e') | CBinOp (_, e, e') -> | IReset (e, e') | IWhen (e, e') | IComp (_, e, e') | IBinOp (_, e, e') ->
begin begin
match find_app_expr_opt i e with match find_app_expr_opt i e with
| None -> find_app_expr_opt i e' | None -> find_app_expr_opt i e'
| Some n -> Some n | Some n -> Some n
end end
| CTriOp (_, e, e', e'') -> | ITriOp (_, e, e', e'') ->
begin begin
match find_app_expr_opt i e with match find_app_expr_opt i e with
| None -> | None ->
@ -21,15 +21,15 @@ let rec find_app_opt eqs i =
end end
| Some n -> Some n | Some n -> Some n
end end
| CTuple l -> | ITuple l ->
List.fold_left List.fold_left
(fun acc e -> (fun acc e ->
match acc, find_app_expr_opt i e with match acc, find_app_expr_opt i e with
| Some n, _ -> Some n | Some n, _ -> Some n
| None, v -> v) | None, v -> v)
None l None l
(** [CApp] below represents the n-th call to an aux node *) (** [IApp] below represents the n-th call to an aux node *)
| CApp (j, n, e) -> | IApp (j, n, e) ->
if i = j if i = j
then Some n then Some n
else find_app_expr_opt i e else find_app_expr_opt i e