[parser] fixes + pretty_printers
This commit is contained in:
parent
74c04a0e4e
commit
f84279c5d8
@ -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
|
||||||
|
let n: Ast.t_node =
|
||||||
|
{ n_name = node_name;
|
||||||
n_inputs = $3;
|
n_inputs = $3;
|
||||||
n_outputs = $7;
|
n_outputs = $7;
|
||||||
n_local_vars = $10;
|
n_local_vars = $10;
|
||||||
n_equations = $12; }
|
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
src/pp.ml
135
src/pp.ml
@ -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,37 +7,46 @@ 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
|
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| h :: [] -> Format.fprintf fmt "%s" h
|
| IVar h :: [] -> Format.fprintf fmt "%s" h
|
||||||
| h :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_pattern_aux (h' :: l)
|
| RVar h :: [] -> Format.fprintf fmt "%s" h
|
||||||
in
|
| BVar h :: [] -> Format.fprintf fmt "%s" h
|
||||||
match pat with
|
| (IVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: l)
|
||||||
| PP_var v -> Format.fprintf fmt "variable %s" v
|
| (BVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: l)
|
||||||
| PP_tuple l -> Format.fprintf fmt "tuple ( %a )" pp_pattern_aux l
|
| (RVar h) :: h' :: l -> Format.fprintf fmt "%s, %a" h pp_varlist (h' :: 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
|
||||||
@ -51,21 +54,32 @@ let pp_expression =
|
|||||||
| 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
|
(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
|
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
|
||||||
|
|
||||||
*)
|
|
||||||
|
Loading…
Reference in New Issue
Block a user