From f84279c5d81a2f2f9ac07f4200ebbf8871f60c9c Mon Sep 17 00:00:00 2001 From: Arnaud DABY-SEESARAM Date: Fri, 9 Dec 2022 15:47:27 +0100 Subject: [PATCH] [parser] fixes + pretty_printers --- src/parser.mly | 22 ++++---- src/pp.ml | 141 ++++++++++++++++++++++++++----------------------- 2 files changed, 89 insertions(+), 74 deletions(-) diff --git a/src/parser.mly b/src/parser.mly index c6d6fa5..74dc112 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -11,14 +11,14 @@ match Hashtbl.find_opt defined_nodes n with | None -> raise (MyParsingError - ("The node %s does not exist.")) + ("The node "^n^" does not exist.")) | Some node -> node let fetch_var (n: Ast.ident) = match Hashtbl.find_opt defined_vars n with | None -> raise (MyParsingError - ("The var %s does not exist.")) + ("The var "^n^" does not exist.")) | Some var -> var %} @@ -87,11 +87,14 @@ node_content: RETURNS LPAREN out_params RPAREN SEMICOL local_params LET equations TEL - { { n_name = $1; - n_inputs = $3; - n_outputs = $7; - n_local_vars = $10; - n_equations = $12; } + { let node_name = $1 in + let n: Ast.t_node = + { n_name = node_name; + n_inputs = $3; + n_outputs = $7; + n_local_vars = $10; + n_equations = $12; } in + Hashtbl.add defined_nodes node_name n; n } ; in_params: @@ -107,7 +110,8 @@ local_params: ; param_list_semicol: - | param_list SEMICOL { $1 } + | param SEMICOL { $1 } + | param SEMICOL param_list_semicol { $1 @ $3 } param_list: | param { $1 } @@ -135,7 +139,7 @@ ident_comma_list: equations: | /* empty */ { [] } | equation SEMICOL equations - { $1 :: $3 } + { $1 :: $3 } ; equation: diff --git a/src/pp.ml b/src/pp.ml index 60f79e9..4c6ef37 100644 --- a/src/pp.ml +++ b/src/pp.ml @@ -1,11 +1,5 @@ open Ast -let pp_ident fmt (s: ident): unit = Format.fprintf fmt "%s" s - -let pp_ast fmt (nodes: t_nodelist) = () - -(*open Ast - let pp_loc fmt (start, stop) = Lexing.( Format.fprintf fmt "%s: -- " @@ -13,59 +7,79 @@ let pp_loc fmt (start, stop) = start.pos_lnum start.pos_cnum stop.pos_lnum stop.pos_cnum) -let pp_pattern fmt pat = - let rec pp_pattern_aux fmt l = - match l with - | [] -> () - | h :: [] -> Format.fprintf fmt "%s" h - | h :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_pattern_aux (h' :: l) - in - match pat with - | PP_var v -> Format.fprintf fmt "variable %s" v - | PP_tuple l -> Format.fprintf fmt "tuple ( %a )" pp_pattern_aux l +let rec pp_varlist fmt : t_varlist -> unit = function + | [] -> () + | IVar h :: [] -> Format.fprintf fmt "%s" h + | RVar h :: [] -> Format.fprintf fmt "%s" h + | BVar h :: [] -> Format.fprintf fmt "%s" h + | (IVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: l) + | (BVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: l) + | (RVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: l) let pp_expression = - let upd_prefix s = s ^ " " in + let upd_prefix s = s ^ " | " in let rec pp_expression_aux prefix fmt expression = let rec pp_expression_list prefix fmt exprs = match exprs with - | [] -> () - | expr :: exprs -> + | ETuple([]) -> () + | ETuple (expr :: exprs) -> Format.fprintf fmt "%a%a" (pp_expression_aux (prefix^" |> ")) expr - (pp_expression_list prefix) exprs + (pp_expression_list prefix) (ETuple exprs) + | _ -> raise (MyTypeError "This exception should not have been raised.") in match expression with - | PE_Const c -> + | EWhen (e1, e2) -> + begin + Format.fprintf fmt "\t\t\t%sWHEN\n%a\t\t\tWHEN\n%a" + prefix + (pp_expression_aux (upd_prefix prefix)) e1 + (pp_expression_aux (upd_prefix prefix)) e2 + end + | EConst c -> begin match c with | CBool true -> Format.fprintf fmt "\t\t\t%s\n" prefix | CBool false -> Format.fprintf fmt "\t\t\t%s\n" prefix | CInt i -> Format.fprintf fmt "\t\t\t%s<%5d: int>\n" prefix i + | CReal r -> Format.fprintf fmt "\t\t\t%s<%5f: float>\n" prefix r end - | PE_Var v -> Format.fprintf fmt "\t\t\t%s\n" prefix v - | PE_MonOp (mop, arg) -> + | EVar (IVar v) -> Format.fprintf fmt "\t\t\t%s\n" prefix v + | EVar (BVar v) -> Format.fprintf fmt "\t\t\t%s\n" prefix v + | EVar (RVar v) -> Format.fprintf fmt "\t\t\t%s\n" prefix v + | EMonOp (mop, arg) -> begin match mop with | MOp_not -> - Format.fprintf fmt "\t\t\t%s¬\n%a" prefix + Format.fprintf fmt "\t\t\t%s ¬ \n%a" prefix (pp_expression_aux (upd_prefix prefix)) arg | MOp_minus -> - Format.fprintf fmt "\t\t\t%s—\n%a" prefix + Format.fprintf fmt "\t\t\t%s — \n%a" prefix + (pp_expression_aux (upd_prefix prefix)) arg + | MOp_pre -> + Format.fprintf fmt "\t\t\t%spre\n%a" prefix (pp_expression_aux (upd_prefix prefix)) arg end - | PE_BinOp (bop, arg, arg') -> + | EBinOp (bop, arg, arg') -> begin let s = match bop with | BOp_add -> " + " | BOp_sub -> " - " | BOp_mul -> " ∗ " | BOp_div -> " / " | BOp_mod -> "% " - | BOp_and -> "&& " | BOp_or -> "|| " | BOp_eq -> "== " - | BOp_neq -> " ≠ " - | BOp_le -> " ≤ " | BOp_lt -> " < " - | BOp_ge -> " ≥ " | BOp_gt -> " > " in + | BOp_and -> "&& " | BOp_or -> "|| " | BOp_arrow -> "-> " in Format.fprintf fmt "\t\t\t%s%s\n%a%a" prefix s (pp_expression_aux (upd_prefix prefix)) arg (pp_expression_aux (upd_prefix prefix)) arg' end - | PE_TriOp (top, arg, arg', arg'') -> + | EComp (cop, arg, arg') -> + begin + let s = match cop with + | COp_eq -> "== " + | COp_neq -> " ≠ " + | COp_le -> " ≤ " | COp_lt -> " < " + | COp_ge -> " ≥ " | COp_gt -> " > " in + Format.fprintf fmt "\t\t\t%s%s\n%a%a" prefix s + (pp_expression_aux (upd_prefix prefix)) arg + (pp_expression_aux (upd_prefix prefix)) arg' + end + | ETriOp (top, arg, arg', arg'') -> begin match top with | TOp_if -> Format.fprintf fmt "\t\t\t%sIF\n%a\t\t\tTHEN\n%a\t\t\tELSE\n%a" @@ -73,53 +87,51 @@ let pp_expression = (pp_expression_aux (upd_prefix prefix)) arg (pp_expression_aux (upd_prefix prefix)) arg' (pp_expression_aux (upd_prefix prefix)) arg'' + | TOp_merge -> + Format.fprintf fmt "\t\t\t%sMERGE ON CLK\n%a\t\t\tE1\n%a\t\t\tE2\n%a" + prefix + (pp_expression_aux (upd_prefix prefix)) arg + (pp_expression_aux (upd_prefix prefix)) arg' + (pp_expression_aux (upd_prefix prefix)) arg'' end - | PE_app (f, args) -> + | EApp (f, args) -> Format.fprintf fmt "\t\t\t%sApp %s\n%a" - prefix f + prefix f.n_name (pp_expression_list prefix) args - | PE_tuple args -> + | ETuple args -> Format.fprintf fmt "\t\t\t%sTuple\n%a" prefix - (pp_expression_list prefix) args; - | PE_pre expr -> - Format.fprintf fmt "\t\t\t%spre\n%a" prefix - (pp_expression_aux (upd_prefix prefix)) expr - | PE_arrow (expr, expr') -> - Format.fprintf fmt "%a%a" - (pp_expression_aux (upd_prefix prefix)) expr - (pp_expression_aux (prefix^" -> ")) expr' + (pp_expression_list prefix) (ETuple args); in pp_expression_aux "" -let rec pp_equations fmt eqs = - match eqs with +let rec pp_equations fmt: t_eqlist -> unit = function | [] -> () - | eq :: eqs -> + | (patt, expr) :: eqs -> Format.fprintf fmt "\t\t∗ left side: %a\n\t\t right side:\n%a\n%a" - pp_pattern eq.peq_patt - pp_expression eq.peq_expr + pp_varlist patt + pp_expression expr pp_equations eqs -let rec pp_node_vars fmt vars = - match vars with +let rec pp_node_vars fmt = function | [] -> () - | (v, t) :: vars -> - Format.fprintf fmt "\t\tVariable \n%a" - v - (match t with - | Tbool -> "bool" - | Tint -> "int") - pp_node_vars vars + | BVar n :: vars -> + Format.fprintf fmt "\t\tVariable \n%a" + n pp_node_vars vars + | IVar n :: vars -> + Format.fprintf fmt "\t\tVariable \n%a" + n pp_node_vars vars + | RVar n :: vars -> + Format.fprintf fmt "\t\tVariable \n%a" + n pp_node_vars vars let pp_node fmt node = Format.fprintf fmt "\t∗ Nom du nœud : %s\n\t Inputs:\n%a\n\t Outputs:\n%a\n\t\ - \ \ Local variables:\n%a\n\t Equations:\n%a\n\t Location in the parsed file: %a\n" - node.pn_name - pp_node_vars node.pn_input - pp_node_vars node.pn_output - pp_node_vars node.pn_local_vars - pp_equations node.pn_equations - pp_loc node.pn_loc + \ \ Local variables:\n%a\n\t Equations:\n%a\n" + node.n_name + pp_node_vars node.n_inputs + pp_node_vars node.n_outputs + pp_node_vars node.n_local_vars + pp_equations node.n_equations let rec pp_nodes fmt nodes = match nodes with @@ -127,10 +139,9 @@ let rec pp_nodes fmt nodes = | node :: nodes -> Format.fprintf fmt "%a\n%a" pp_node node pp_nodes nodes -let pp_prog fmt prog = +let pp_ast fmt prog = Format.fprintf fmt "Le programme est composé de %d nœud(s), listés ci-dessous :\n%a" (List.length prog) pp_nodes prog -*)