From 3ad133344a67a8ca1eadb694c4f2803928e00286 Mon Sep 17 00:00:00 2001 From: Arnaud DABY-SEESARAM Date: Tue, 20 Dec 2022 14:02:00 +0100 Subject: [PATCH 1/5] [lustre_pp] precise error messages --- src/lustre_pp.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/lustre_pp.ml b/src/lustre_pp.ml index 11335b4..c515449 100644 --- a/src/lustre_pp.ml +++ b/src/lustre_pp.ml @@ -37,7 +37,7 @@ let rec pp_varlist fmt : t_varlist -> unit = function Format.fprintf fmt "%s: bool, %a" h pp_varlist (tl, h' :: l) | (TReal :: tl, RVar h :: h' :: l) -> Format.fprintf fmt "%s: real, %a" h pp_varlist (tl, h' :: l) - | _ -> raise (MyTypeError "This exception should not have beed be raised.") + | _ -> raise (MyTypeError "(1) This exception should not have beed be raised.") let pp_expression = let upd_prefix s = s ^ " | " in @@ -49,7 +49,9 @@ let pp_expression = Format.fprintf fmt "%a%a" (pp_expression_aux (prefix^" |> ")) expr (pp_expression_list prefix) (ETuple (tt, exprs)) - | _ -> raise (MyTypeError "This exception should not have been raised.") + | ETuple ([], _) -> failwith "A non-empty tuple has no type!" + | ETuple (_, []) -> failwith "An empty tuple has a type!" + | _ -> failwith "This exception should never occur." in match expression with | EWhen (_, e1, e2) -> From c7edb27fb0eeb8be2b6cd11d7a35eb83d966f94a Mon Sep 17 00:00:00 2001 From: Arnaud DABY-SEESARAM Date: Tue, 20 Dec 2022 14:04:50 +0100 Subject: [PATCH 2/5] [lustre_pp] fix a typing error --- src/lustre_pp.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/lustre_pp.ml b/src/lustre_pp.ml index c515449..01d5b0c 100644 --- a/src/lustre_pp.ml +++ b/src/lustre_pp.ml @@ -45,11 +45,12 @@ let pp_expression = let rec pp_expression_list prefix fmt exprs = match exprs with | ETuple([], []) -> () - | ETuple (_ :: tt, expr :: exprs) -> + | ETuple (typs, expr :: exprs) -> + let typ_h, typ_t = + Utils.list_select (List.length (Utils.type_exp expr)) typs in Format.fprintf fmt "%a%a" (pp_expression_aux (prefix^" |> ")) expr - (pp_expression_list prefix) (ETuple (tt, exprs)) - | ETuple ([], _) -> failwith "A non-empty tuple has no type!" + (pp_expression_list prefix) (ETuple (typ_t, exprs)) | ETuple (_, []) -> failwith "An empty tuple has a type!" | _ -> failwith "This exception should never occur." in From 42536df81c012e93eacd15638b8b4b7ee6fb464a Mon Sep 17 00:00:00 2001 From: Arnaud DABY-SEESARAM Date: Tue, 20 Dec 2022 14:10:34 +0100 Subject: [PATCH 3/5] [parser] update of some error messages --- src/parser.mly | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parser.mly b/src/parser.mly index ef3504e..f15de24 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -313,15 +313,15 @@ expr: | MO_pre expr { EMonOp (type_exp $2, MOp_pre, $2) } | MINUS expr { monop_neg_condition $2 [TBool] - "You cannot take the opposite of a boolean expression." + "You cannot take the opposite of an expression that is not a number." (EMonOp (type_exp $2, MOp_minus, $2)) } | PLUS expr { monop_neg_condition $2 [TBool] - "You cannot take the plus of a boolean expression." $2 } + "(+) expects its argument to be a number." $2 } /* Binary operators */ | expr PLUS expr { make_binop_nonbool $1 $3 BOp_add - "You should know better; addition hates booleans" } + "Addition expects both arguments to be (the same kind of) numbers." } | expr MINUS expr { make_binop_nonbool $1 $3 BOp_sub "You should know better; subtraction hates booleans" } From f121f55432ee3be849f2eca2ca36015a970069ca Mon Sep 17 00:00:00 2001 From: Arnaud DABY-SEESARAM Date: Tue, 20 Dec 2022 15:11:12 +0100 Subject: [PATCH 4/5] [cprint] add a main function --- src/ast_to_c.ml | 7 +-- src/config.ml | 2 +- src/cprint.ml | 126 ++++++++++++++++++++++++++++++++++++++++++++++++ src/test.node | 14 +----- 4 files changed, 133 insertions(+), 16 deletions(-) diff --git a/src/ast_to_c.ml b/src/ast_to_c.ml index dbdbd5e..0f1e4af 100644 --- a/src/ast_to_c.ml +++ b/src/ast_to_c.ml @@ -310,9 +310,10 @@ let ast_to_c verbose debug prog = verbose "Computation of the node_states"; let prog_st_types = make_state_types prog in debug (Format.asprintf "%a" dump_var_locations prog_st_types); - let prog: i_nodelist = ast_to_intermediate_ast prog prog_st_types in - Format.printf "%a\n\n%a\n\n/* Nodes: */\n%a" + let iprog: i_nodelist = ast_to_intermediate_ast prog prog_st_types in + Format.printf "%a\n\n%a\n\n/* Nodes: */\n%a%a\n" cp_includes (Config.c_includes) cp_state_types prog_st_types - cp_nodes (prog, prog_st_types) + cp_nodes (iprog, prog_st_types) + cp_main_fn (prog, prog_st_types) diff --git a/src/config.ml b/src/config.ml index 1ad7133..c89bff4 100644 --- a/src/config.ml +++ b/src/config.ml @@ -3,4 +3,4 @@ * variables. *) let maxvar = 100 -let c_includes = ["stdbool"; "stdlib"] +let c_includes = ["stdbool"; "stdlib"; "stdio"; "string"] diff --git a/src/cprint.ml b/src/cprint.ml index 759c1c2..3df57af 100644 --- a/src/cprint.ml +++ b/src/cprint.ml @@ -218,3 +218,129 @@ and cp_expression fmt (expr, hloc) = p; prefix_ := p + + +(** [cp_main] tries to print a main function to the C code. + * If there is a function [main] in the lustre program, it will generate a main + * function in the C code, otherwise it does not do anything. + *) +let cp_main_fn fmt (prog, sts) = + let rec cp_array fmt (vl: t_var list): unit = + match vl with + | [] -> () + | v :: vl -> + let typ, name = + match v with + | IVar s -> ("int", s) + | RVar s -> ("double", s) + | BVar s -> + Format.fprintf fmt "\tchar _char_of_%s;\n" s; + ("bool", s) + in + Format.fprintf fmt "\t%s %s;\n%a" typ name + cp_array vl + in + let rec cp_inputs fmt (f, l) = + match f, l with + | _, [] -> () + | true, h :: t -> + Format.fprintf fmt ", %s%a" + (Utils.name_of_var h) + cp_inputs (true, t) + | false, h :: t -> + Format.fprintf fmt "%s%a" + (Utils.name_of_var h) + cp_inputs (true, t) + in + let cp_scanf fmt vl = + let rec cp_scanf_str fmt (b, vl) = + match b, vl with + | _, [] -> () + | true, h :: t -> + Format.fprintf fmt " %s%a" + (match h with + | IVar _ -> "%d" + | BVar _ -> "%c" + | RVar _ -> "%lf") + cp_scanf_str (true, t) + | false, h :: t -> + Format.fprintf fmt "%s%a" + (match h with + | IVar _ -> "%d" + | BVar _ -> "%c" + | RVar _ -> "%lf") + cp_scanf_str (true, t) + in + let rec cp_scanf_args fmt vl = + match vl with + | [] -> () + | RVar s :: vl | IVar s :: vl -> + Format.fprintf fmt ", &%s%a" s cp_scanf_args vl + | BVar s :: vl -> + Format.fprintf fmt ", &%s%a" (Format.sprintf "_char_of_%s" s) + cp_scanf_args vl + in + Format.fprintf fmt "\"%a\"%a" + cp_scanf_str (false, vl) + cp_scanf_args vl + in + let cp_printf fmt vl = + let rec cp_printf_str fmt (b, vl) = + match b, vl with + | _, [] -> () + | true, h :: t -> + Format.fprintf fmt " %s%a" + (match h with + | IVar _ -> "%d" + | BVar _ -> "%c" + | RVar _ -> "%f") + cp_printf_str (true, t) + | false, h :: t -> + Format.fprintf fmt "%s%a" + (match h with + | IVar _ -> "%d" + | BVar _ -> "%c" + | RVar _ -> "%f") + cp_printf_str (true, t) + in + let rec cp_printf_arg fmt (h, i) = + match Hashtbl.find_opt h i with + | None -> () + | Some (s, i) -> + Format.fprintf fmt ", state.%s[%d]%a" + s i cp_printf_arg (h, i+1) + in + Format.fprintf fmt "\"%a\"%a" + cp_printf_str (false, vl) + cp_printf_arg ((Hashtbl.find sts "main").nt_output_map, 0) + in + let rec cp_char_to_bool fmt vl = + match vl with + | [] -> () + | RVar _ :: vl | IVar _ :: vl -> Format.fprintf fmt "%a" cp_char_to_bool vl + | BVar s :: vl -> + Format.fprintf fmt "\t\t%s = (%s == 't') ? true : false;\n%a" + s (Format.sprintf "_char_of_%s" s) + cp_char_to_bool vl + in + match List.find_opt (fun n -> n.n_name = "main") prog with + | None -> () + | Some node -> + Format.fprintf fmt "int main (int argc, char **argv)\n\ + {\n%a\n\ + \tchar _buffer[1024];\n\ + \tt_state_main state; state.is_init = true;\n\ + \twhile(true) {\n\ + \t\tscanf(\"%%s\", _buffer);\n\ + \t\tif(!strcmp(_buffer, \"exit\")) { exit (EXIT_SUCCESS); }\n\ + \t\tsscanf(_buffer, %a);\n%a\ + \t\tfn_main(&state, %a);\n\ + \t\tprintf(%a);\n\ + \t}\n\ + \treturn EXIT_SUCCESS;\n\ + }\n" + cp_array (snd node.n_inputs) + cp_scanf (snd node.n_inputs) + cp_char_to_bool (snd node.n_inputs) + cp_inputs (false, snd node.n_inputs) + cp_printf (snd node.n_outputs) diff --git a/src/test.node b/src/test.node index d6f531d..3c3e9a8 100644 --- a/src/test.node +++ b/src/test.node @@ -1,15 +1,5 @@ -node id (a: bool) returns (o: bool); +node main (i: int) returns (a, b: int); let - o = a; + (a, b) = (i, i); tel -node test_merge_tuples (a, b: bool) returns (o: bool); -var t: bool; -let - (o, t) = if a and b then (true, false) else (false, true); -tel - -node my_and (a, b: bool) returns (o: bool); -let - o = if a then b else id(false -> a); -tel From 52092b1480f10f9ea2c72fe3b4d847088851c893 Mon Sep 17 00:00:00 2001 From: Arnaud DABY-SEESARAM Date: Tue, 20 Dec 2022 15:24:55 +0100 Subject: [PATCH 5/5] [cprint] code reduction --- src/cprint.ml | 48 ++++++++++++++++++------------------------------ 1 file changed, 18 insertions(+), 30 deletions(-) diff --git a/src/cprint.ml b/src/cprint.ml index 3df57af..fb56053 100644 --- a/src/cprint.ml +++ b/src/cprint.ml @@ -241,30 +241,23 @@ let cp_main_fn fmt (prog, sts) = cp_array vl in let rec cp_inputs fmt (f, l) = - match f, l with - | _, [] -> () - | true, h :: t -> - Format.fprintf fmt ", %s%a" - (Utils.name_of_var h) - cp_inputs (true, t) - | false, h :: t -> - Format.fprintf fmt "%s%a" + match l with + | [] -> () + | h :: t -> + (if f + then Format.fprintf fmt ", %s%a" + else Format.fprintf fmt "%s%a") (Utils.name_of_var h) cp_inputs (true, t) in let cp_scanf fmt vl = let rec cp_scanf_str fmt (b, vl) = - match b, vl with - | _, [] -> () - | true, h :: t -> - Format.fprintf fmt " %s%a" - (match h with - | IVar _ -> "%d" - | BVar _ -> "%c" - | RVar _ -> "%lf") - cp_scanf_str (true, t) - | false, h :: t -> - Format.fprintf fmt "%s%a" + match vl with + | [] -> () + | h :: t -> + (if b + then Format.fprintf fmt " %s%a" + else Format.fprintf fmt "%s%a") (match h with | IVar _ -> "%d" | BVar _ -> "%c" @@ -286,17 +279,12 @@ let cp_main_fn fmt (prog, sts) = in let cp_printf fmt vl = let rec cp_printf_str fmt (b, vl) = - match b, vl with - | _, [] -> () - | true, h :: t -> - Format.fprintf fmt " %s%a" - (match h with - | IVar _ -> "%d" - | BVar _ -> "%c" - | RVar _ -> "%f") - cp_printf_str (true, t) - | false, h :: t -> - Format.fprintf fmt "%s%a" + match vl with + | [] -> () + | h :: t -> + (if b + then Format.fprintf fmt " %s%a" + else Format.fprintf fmt "%s%a") (match h with | IVar _ -> "%d" | BVar _ -> "%c"