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

[parser] fixes + pretty_printers

Browse Source
This commit is contained in:
Arnaud DABY-SEESARAM 2022-12-09 15:47:27 +01:00
parent 74c04a0e4e
commit f84279c5d8
2 changed files with 89 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/parser.mly
View File

@ -11,14 +11,14 @@
match Hashtbl.find_opt defined_nodes n with match Hashtbl.find_opt defined_nodes n with
| None -> | None ->
raise (MyParsingError raise (MyParsingError
("The node %s does not exist.")) ("The node "^n^" does not exist."))
| Some node -> node | Some node -> node
let fetch_var (n: Ast.ident) = let fetch_var (n: Ast.ident) =
match Hashtbl.find_opt defined_vars n with match Hashtbl.find_opt defined_vars n with
| None -> | None ->
raise (MyParsingError raise (MyParsingError
("The var %s does not exist.")) ("The var "^n^" does not exist."))
| Some var -> var | Some var -> var
%} %}
@ -87,11 +87,14 @@ node_content:
RETURNS LPAREN out_params RPAREN SEMICOL RETURNS LPAREN out_params RPAREN SEMICOL
local_params local_params
LET equations TEL LET equations TEL
{ { n_name = $1; { let node_name = $1 in
n_inputs = $3; let n: Ast.t_node =
n_outputs = $7; { n_name = node_name;
n_local_vars = $10; n_inputs = $3;
n_equations = $12; } n_outputs = $7;
n_local_vars = $10;
n_equations = $12; } in
Hashtbl.add defined_nodes node_name n; n
} ; } ;
in_params: in_params:
@ -107,7 +110,8 @@ local_params:
; ;
param_list_semicol: param_list_semicol:
| param_list SEMICOL { $1 } | param SEMICOL { $1 }
| param SEMICOL param_list_semicol { $1 @ $3 }
param_list: param_list:
| param { $1 } | param { $1 }
@ -135,7 +139,7 @@ ident_comma_list:
equations: equations:
| /* empty */ { [] } | /* empty */ { [] }
| equation SEMICOL equations | equation SEMICOL equations
{ $1 :: $3 } { $1 :: $3 }
; ;
equation: equation:

141
src/pp.ml
View File

@ -1,11 +1,5 @@
open Ast 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) = let pp_loc fmt (start, stop) =
Lexing.( Lexing.(
Format.fprintf fmt "%s: <l: %d, c: %d> -- <l: %d, c: %d>" Format.fprintf fmt "%s: <l: %d, c: %d> -- <l: %d, c: %d>"
@ -13,59 +7,79 @@ let pp_loc fmt (start, stop) =
start.pos_lnum start.pos_cnum start.pos_lnum start.pos_cnum
stop.pos_lnum stop.pos_cnum) stop.pos_lnum stop.pos_cnum)
let pp_pattern fmt pat = let rec pp_varlist fmt : t_varlist -> unit = function
let rec pp_pattern_aux fmt l = | [] -> ()
match l with | IVar h :: [] -> Format.fprintf fmt "%s" h
| [] -> () | RVar h :: [] -> Format.fprintf fmt "%s" h
| h :: [] -> Format.fprintf fmt "%s" h | BVar h :: [] -> Format.fprintf fmt "%s" h
| h :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_pattern_aux (h' :: l) | (IVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: l)
in | (BVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: l)
match pat with | (RVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: l)
| PP_var v -> Format.fprintf fmt "variable %s" v
| PP_tuple l -> Format.fprintf fmt "tuple ( %a )" pp_pattern_aux l
let pp_expression = 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_aux prefix fmt expression =
let rec pp_expression_list prefix fmt exprs = let rec pp_expression_list prefix fmt exprs =
match exprs with match exprs with
| [] -> () | ETuple([]) -> ()
| expr :: exprs -> | ETuple (expr :: exprs) ->
Format.fprintf fmt "%a%a" Format.fprintf fmt "%a%a"
(pp_expression_aux (prefix^" |> ")) expr (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 in
match expression with 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 begin match c with
| CBool true -> Format.fprintf fmt "\t\t\t%s<true : bool>\n" prefix | CBool true -> Format.fprintf fmt "\t\t\t%s<true : bool>\n" prefix
| CBool false -> Format.fprintf fmt "\t\t\t%s<false : bool>\n" prefix | CBool false -> Format.fprintf fmt "\t\t\t%s<false : bool>\n" prefix
| CInt i -> Format.fprintf fmt "\t\t\t%s<%5d: int>\n" prefix i | 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 end
| PE_Var v -> Format.fprintf fmt "\t\t\t%s<var %s>\n" prefix v | EVar (IVar v) -> Format.fprintf fmt "\t\t\t%s<int var %s>\n" prefix v
| PE_MonOp (mop, arg) -> | EVar (BVar v) -> Format.fprintf fmt "\t\t\t%s<bool var %s>\n" prefix v
| EVar (RVar v) -> Format.fprintf fmt "\t\t\t%s<real var %s>\n" prefix v
| EMonOp (mop, arg) ->
begin match mop with begin match mop with
| MOp_not -> | 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 (pp_expression_aux (upd_prefix prefix)) arg
| MOp_minus -> | 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 (pp_expression_aux (upd_prefix prefix)) arg
end end
| PE_BinOp (bop, arg, arg') -> | EBinOp (bop, arg, arg') ->
begin begin
let s = match bop with let s = match bop with
| BOp_add -> " + " | BOp_sub -> " - " | BOp_add -> " + " | BOp_sub -> " - "
| BOp_mul -> " ∗ " | BOp_div -> " / " | BOp_mod -> "% " | BOp_mul -> " ∗ " | BOp_div -> " / " | BOp_mod -> "% "
| BOp_and -> "&& " | BOp_or -> "|| " | BOp_eq -> "== " | BOp_and -> "&& " | BOp_or -> "|| " | BOp_arrow -> "-> " in
| BOp_neq -> " ≠ "
| BOp_le -> " ≤ " | BOp_lt -> " < "
| BOp_ge -> " ≥ " | BOp_gt -> " > " in
Format.fprintf fmt "\t\t\t%s%s\n%a%a" prefix s 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
(pp_expression_aux (upd_prefix prefix)) arg' (pp_expression_aux (upd_prefix prefix)) arg'
end 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 begin match top with
| TOp_if -> | TOp_if ->
Format.fprintf fmt "\t\t\t%sIF\n%a\t\t\tTHEN\n%a\t\t\tELSE\n%a" 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' (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 end
| PE_app (f, args) -> | EApp (f, args) ->
Format.fprintf fmt "\t\t\t%sApp %s\n%a" Format.fprintf fmt "\t\t\t%sApp %s\n%a"
prefix f prefix f.n_name
(pp_expression_list prefix) args (pp_expression_list prefix) args
| PE_tuple args -> | ETuple args ->
Format.fprintf fmt "\t\t\t%sTuple\n%a" prefix Format.fprintf fmt "\t\t\t%sTuple\n%a" prefix
(pp_expression_list prefix) args; (pp_expression_list prefix) (ETuple 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'
in in
pp_expression_aux "" pp_expression_aux ""
let rec pp_equations fmt eqs = let rec pp_equations fmt: t_eqlist -> unit = function
match eqs with
| [] -> () | [] -> ()
| eq :: eqs -> | (patt, expr) :: eqs ->
Format.fprintf fmt "\t\t∗ left side: %a\n\t\t right side:\n%a\n%a" Format.fprintf fmt "\t\t∗ left side: %a\n\t\t right side:\n%a\n%a"
pp_pattern eq.peq_patt pp_varlist patt
pp_expression eq.peq_expr pp_expression expr
pp_equations eqs pp_equations eqs
let rec pp_node_vars fmt vars = let rec pp_node_vars fmt = function
match vars with
| [] -> () | [] -> ()
| (v, t) :: vars -> | BVar n :: vars ->
Format.fprintf fmt "\t\tVariable <name: %10s,\ttype: %s>\n%a" Format.fprintf fmt "\t\tVariable <name: %10s,\ttype: bool>\n%a"
v n pp_node_vars vars
(match t with | IVar n :: vars ->
| Tbool -> "bool" Format.fprintf fmt "\t\tVariable <name: %10s,\ttype: int>\n%a"
| Tint -> "int") n pp_node_vars vars
pp_node_vars vars | RVar n :: vars ->
Format.fprintf fmt "\t\tVariable <name: %10s,\ttype: real>\n%a"
n pp_node_vars vars
let pp_node fmt node = 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\ 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" \ \ Local variables:\n%a\n\t Equations:\n%a\n"
node.pn_name node.n_name
pp_node_vars node.pn_input pp_node_vars node.n_inputs
pp_node_vars node.pn_output pp_node_vars node.n_outputs
pp_node_vars node.pn_local_vars pp_node_vars node.n_local_vars
pp_equations node.pn_equations pp_equations node.n_equations
pp_loc node.pn_loc
let rec pp_nodes fmt nodes = let rec pp_nodes fmt nodes =
match nodes with match nodes with
@ -127,10 +139,9 @@ let rec pp_nodes fmt nodes =
| node :: nodes -> | node :: nodes ->
Format.fprintf fmt "%a\n%a" pp_node node pp_nodes 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 Format.fprintf fmt
"Le programme est composé de %d nœud(s), listés ci-dessous :\n%a" "Le programme est composé de %d nœud(s), listés ci-dessous :\n%a"
(List.length prog) (List.length prog)
pp_nodes prog pp_nodes prog
*)