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

[parser] new parser, no more pp (for now)

Browse Source
This commit is contained in:
Arnaud DABY-SEESARAM
2022-12-09 14:26:28 +01:00
parent b57cee3f73
commit 74c04a0e4e
5 changed files with 264 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

161
src/ast.ml
View File

@@ -1,65 +1,142 @@
type location = Lexing.position * Lexing.position exception MyTypeError of string
type ident = string type location = Lexing.position * Lexing.position
type real = float type real = float
type _ const = type ident = string
| CReal: real -> real const
| CBool: bool -> bool const type base_ty =
| CInt: int -> int const | TBool
| TInt
| TReal
type const =
| CReal of real
| CBool of bool
| CInt of int
type monop = type monop =
| MOp_not | MOp_minus | MOp_pre | MOp_not | MOp_minus | MOp_pre
type binop = type binop =
| BOp_add | BOp_sub | BOp_mul | BOp_div | BOp_mod | BOp_add | BOp_sub | BOp_mul | BOp_div | BOp_mod
| BOp_and | BOp_or | BOp_when | BOp_and | BOp_or | BOp_arrow
type compop = type compop =
| BOp_eq | BOp_neq | COp_eq | COp_neq
| BOp_le | BOp_lt | BOp_ge | BOp_gt | COp_le | COp_lt | COp_ge | COp_gt
type triop = type triop =
| TOp_if | TOp_merge | TOp_if | TOp_merge
type _ t_var = type t_var =
| BVar: ident -> bool t_var | BVar of ident
| IVar: ident -> int t_var | IVar of ident
| RVar: ident -> real t_var | RVar of ident
type _ t_expression = type t_expression =
| EVar: 'a t_var -> 'a t_expression | EVar of t_var
| EMonOp: monop * 'a t_expression -> 'a t_expression | EMonOp of monop * t_expression
| EBinOp: binop * 'a t_expression * 'a t_expression -> 'a t_expression | EBinOp of binop * t_expression * t_expression
| ETriOp: triop * bool t_expression * 'a t_expression * 'a t_expression -> 'a t_expression | ETriOp of triop * t_expression * t_expression * t_expression
| EComp: compop * 'a t_expression * 'a t_expression -> bool t_expression | EComp of compop * t_expression * t_expression
| EConst: 'a const -> 'a t_expression | EWhen of t_expression * t_expression
| ETuple: 'a t_expression * 'b t_expression -> ('a * 'b) t_expression | EConst of const
| EApp: (('a -> 'b) t_node) * 'a t_expression -> 'b t_expression | ETuple of t_expression list
| EApp of t_node * t_expression
and _ t_varlist = and t_varlist = t_var list
| NVar: 'a t_varlist
| CVar: 'a t_var * 'b t_varlist -> ('a * 'b) t_varlist
and 'a t_equation = 'a t_varlist * 'a t_expression and t_equation = t_varlist * t_expression
and _ t_eqlist = and t_eqlist = t_equation list
| NEql: unit t_eqlist
| CEql: 'a t_equation * 'b t_eqlist -> ('a * 'b) t_eqlist
and _ t_node = and t_node =
| MakeNode: {
ident n_name : ident;
* 'i t_varlist * 'o t_varlist n_inputs: t_varlist;
* 'l t_varlist * 'e t_eqlist n_outputs: t_varlist;
-> ('i -> 'o) t_node n_local_vars: t_varlist;
n_equations: t_eqlist;
}
type _ t_nodelist = type t_nodelist = t_node list
| NNode: unit t_nodelist
| CNode: ('a -> 'b) t_node * 'c t_nodelist -> (('a -> 'b) * 'c) t_nodelist
type full_ty =
| FTArr of full_ty * full_ty
| FTList of full_ty list
| FTBase of base_ty
let varlist_get_type (vl: t_varlist): full_ty =
FTList
(List.map (function
| BVar _ -> FTBase TBool
| IVar _ -> FTBase TInt
| RVar _ -> FTBase TReal) vl)
let rec expression_get_type : t_expression -> full_ty = function
| EVar (BVar s) -> FTBase TBool
| EVar (IVar s) -> FTBase TInt
| EVar (RVar s) -> FTBase TReal
| EMonOp (_, e) -> expression_get_type e
| EBinOp (_, e1, e2) | EComp (_, e1, e2) ->
begin
let t1 = expression_get_type e1 in
let t2 = expression_get_type e2 in
if t1 = t2
then t1
else raise (MyTypeError "A binary operator only works on pairs of \
expressions of the same type.")
end
| ETriOp (_, e1, e2, e3) ->
begin
let t1 = expression_get_type e1 in
let t2 = expression_get_type e2 in
let t3 = expression_get_type e3 in
if t1 = FTBase TBool && t2 = t3
then t2
else raise (MyTypeError "A tertiary operator only works when its \
first argument is a boolean expressions, and its other expressions \
have the same type.")
end
| EWhen (e1, e2) ->
begin
let t1 = expression_get_type e1 in
let t2 = expression_get_type e2 in
if t2 = FTBase TBool
then t1
else raise (MyTypeError "The [when] keywork can only be used if its \
second argument is a boolean expression")
end
| EConst (CInt _) -> FTBase TInt
| EConst (CReal _) -> FTBase TReal
| EConst (CBool _) -> FTBase TBool
| ETuple l ->
begin
FTList (
List.fold_left (fun acc (expr: t_expression) ->
let t = expression_get_type expr in
match t with
| FTList lt -> lt @ acc
| _ -> t :: acc) [] l)
end
| EApp (n, e) ->
begin
let tn = node_get_type n in
let te = expression_get_type e in
match tn with
| FTArr (targs, tout) ->
if te = targs
then tout
else raise (MyTypeError "When applying another node [n], the \
the type of your arguments should match the type of the inputs \
of [n].")
| _ -> raise (MyTypeError "You cannot apply something that is not a \
node, it does not make sense.")
end
and node_get_type n =
FTArr (varlist_get_type n.n_inputs, varlist_get_type n.n_outputs)
type base_ty =
| TBool
| TInt
| TReal

24
src/lexer.mll
View File

@@ -13,24 +13,23 @@
("node", NODE); ("node", NODE);
("returns", RETURNS); ("returns", RETURNS);
("var", VAR); ("var", VAR);
("int", INT); ("int", TYP(Ast.TInt));
("bool", BOOL); ("bool", TYP(Ast.TBool));
("<=", BO_le); ("<=", CMP_le);
(">=", BO_ge); (">=", CMP_ge);
("not", MO_not); ("not", MO_not);
("mod", BO_mod); ("mod", BO_mod);
("&&", BO_and); ("&&", BO_and);
("and", BO_and); ("and", BO_and);
("||", BO_or); ("||", BO_or);
("or", BO_or); ("or", BO_or);
("<>", BO_neq); ("<>", CMP_neq);
("if", IF); ("if", IF);
("then", THEN); ("then", THEN);
("else", ELSE); ("else", ELSE);
("≤", BO_le); ("merge", TO_merge);
("≥", BO_ge ); ("when", WHEN);
("¬", MO_not); ("pre", MO_pre);
("pre", PRE);
("true", CONST_BOOL(true)); ("true", CONST_BOOL(true));
("false", CONST_BOOL(false)); ("false", CONST_BOOL(false));
]; ];
@@ -46,20 +45,21 @@ rule token = parse
['\n' ' ' '\t'] { token lexbuf } (* skip blanks and newlines *) ['\n' ' ' '\t'] { token lexbuf } (* skip blanks and newlines *)
| ident { id_or_keywork (lexeme lexbuf) } | ident { id_or_keywork (lexeme lexbuf) }
| digit+ { CONST_INT(int_of_string (lexeme lexbuf)) } | digit+ { CONST_INT(int_of_string (lexeme lexbuf)) }
| digit*'.'digit+ { CONST_REAL(float_of_string (lexeme lexbuf)) }
| ',' { COMMA } | ',' { COMMA }
| '=' { EQUAL } | '=' { EQUAL }
| '(' { LPAREN } | '(' { LPAREN }
| ')' { RPAREN } | ')' { RPAREN }
| ';' { SEMICOL } | ';' { SEMICOL }
| ':' { COLON } | ':' { COLON }
| '<' { BO_lt } | '<' { CMP_lt }
| '>' { BO_gt } | '>' { CMP_gt }
| '+' { PLUS } | '+' { PLUS }
| '-' { MINUS } | '-' { MINUS }
| '*' { BO_mul } | '*' { BO_mul }
| '/' { BO_div } | '/' { BO_div }
| '%' { BO_mod } | '%' { BO_mod }
| "->" { ARROW } | "->" { BO_arrow }
| eof { EOF } | eof { EOF }
| _ { raise (Lexing_error (Format.sprintf "Erruer à la vue de %s" (lexeme lexbuf)))} | _ { raise (Lexing_error (Format.sprintf "Erruer à la vue de %s" (lexeme lexbuf)))}

12
src/main.ml
View File

@@ -19,11 +19,11 @@ let print_verbose v s =
* - The equations are well typed * - The equations are well typed
* - The output is set * - The output is set
*) *)
let check_well_formedness (a: p_prog) = Some a let check_well_formedness (a: t_nodelist) = Some a
let check_dependencies (a: p_prog) = Some a let check_dependencies (a: t_nodelist) = Some a
let simplify_prog (a: p_prog) = Some a let simplify_prog (a: t_nodelist) = Some a
let run verbose debug (passes: (p_prog -> p_prog option) list) let run verbose debug (passes: (t_nodelist -> t_nodelist option) list)
= verbose "kjlksjf" = verbose "kjlksjf"
let _ = let _ =
@@ -53,7 +53,7 @@ let _ =
let print_debug = print_debug !verbose in let print_debug = print_debug !verbose in
(** Definition of the passes table *) (** Definition of the passes table *)
let passes_table : (string, p_prog -> p_prog option) Hashtbl.t = Hashtbl.create 100 in let passes_table : (string, t_nodelist -> t_nodelist option) Hashtbl.t = Hashtbl.create 100 in
List.iter (fun (s, k) -> Hashtbl.add passes_table s k) List.iter (fun (s, k) -> Hashtbl.add passes_table s k)
[ [
("check_form", check_well_formedness); ("check_form", check_well_formedness);
@@ -73,7 +73,7 @@ let _ =
with Lexer.Lexing_error s -> with Lexer.Lexing_error s ->
exit_error (Format.sprintf "Code d'erreur:\n\t%s\n\n" s); exit 0 in exit_error (Format.sprintf "Code d'erreur:\n\t%s\n\n" s); exit 0 in
if !ppast then Format.printf "%a" Pp.pp_prog ast if !ppast then Format.printf "%a" Pp.pp_ast ast
else else
let passes = List.map (fun (pass: string) -> let passes = List.map (fun (pass: string) ->
match Hashtbl.find_opt passes_table pass with match Hashtbl.find_opt passes_table pass with

180
src/parser.mly
View File

@@ -1,5 +1,26 @@
%{ %{
exception MyParsingError of string
let current_location () = symbol_start_pos (), symbol_end_pos () let current_location () = symbol_start_pos (), symbol_end_pos ()
let defined_nodes : (Ast.ident, Ast.t_node) Hashtbl.t = Hashtbl.create 100
let defined_vars : (Ast.ident, Ast.t_var) Hashtbl.t = Hashtbl.create 100
let fetch_node (n: Ast.ident) =
match Hashtbl.find_opt defined_nodes n with
| None ->
raise (MyParsingError
("The node %s 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."))
| Some var -> var
%} %}
%token EOF %token EOF
@@ -17,23 +38,26 @@
%token VAR %token VAR
%token EQUAL %token EQUAL
%token COMMA %token COMMA
%token PRE %token<Ast.base_ty> TYP
%token ARROW
%token MO_not %token MO_not
%token BO_le %token MO_pre
%token BO_lt %token PLUS
%token BO_ge %token MINUS
%token BO_gt
%token BO_mod
%token BO_and %token BO_and
%token BO_or %token BO_or
%token BO_mul %token BO_mul
%token BO_neq
%token BO_div %token BO_div
%token BO_mod
%token BO_arrow
%token CMP_le
%token CMP_lt
%token CMP_ge
%token CMP_gt
%token CMP_neq
%token TO_merge
%token PLUS %token WHEN
%token MINUS
%token IF %token IF
%token THEN %token THEN
@@ -41,10 +65,11 @@
%token<int> CONST_INT %token<int> CONST_INT
%token<bool> CONST_BOOL %token<bool> CONST_BOOL
%token<Ast.real> CONST_REAL
/* The Entry Point */ /* The Entry Point */
%start main %start main
%type <Ast.p_prog> main %type <Ast.t_nodelist> main
%% %%
@@ -55,22 +80,24 @@ nodes:
| node nodes { $1 :: $2 }; | node nodes { $1 :: $2 };
node: node:
NODE IDENT LPAREN in_params RPAREN NODE node_content { (* Flush known variables *) Hashtbl.clear defined_vars; $2 }
node_content:
IDENT LPAREN in_params RPAREN
RETURNS LPAREN out_params RPAREN SEMICOL RETURNS LPAREN out_params RPAREN SEMICOL
local_params local_params
LET equations TEL LET equations TEL
{ { pn_name = $2; { { n_name = $1;
pn_input = $4; n_inputs = $3;
pn_output = $8; n_outputs = $7;
pn_local_vars = $11; n_local_vars = $10;
pn_equations = $13; n_equations = $12; }
pn_loc = current_location (); }
} ; } ;
in_params: in_params:
| /* empty */ { [] } | /* empty */ { [] }
| param_list { $1 } | param_list { $1 }
; ;
out_params: param_list { $1 } ; out_params: param_list { $1 } ;
@@ -80,8 +107,7 @@ local_params:
; ;
param_list_semicol: param_list_semicol:
| param SEMICOL { $1 } | param_list SEMICOL { $1 }
| param SEMICOL param_list_semicol { $1 @ $3 }
param_list: param_list:
| param { $1 } | param { $1 }
@@ -89,10 +115,23 @@ param_list:
; ;
param: param:
ident_comma_list COLON typ ident_comma_list COLON TYP
{ let typ = $3 in List.map (fun i -> (i, typ)) $1 } { let typ = $3 in
let idents = $1 in
Ast.(
match typ with
| TBool ->
List.map (fun s -> Hashtbl.add defined_vars s (BVar s); BVar s) idents
| TReal ->
List.map (fun s -> Hashtbl.add defined_vars s (RVar s); RVar s) idents
| TInt ->
List.map (fun s -> Hashtbl.add defined_vars s (IVar s); IVar s) idents) }
; ;
ident_comma_list:
| IDENT { [$1] }
| IDENT COMMA ident_comma_list { $1 :: $3 }
equations: equations:
| /* empty */ { [] } | /* empty */ { [] }
| equation SEMICOL equations | equation SEMICOL equations
@@ -101,53 +140,74 @@ equations:
equation: equation:
pattern EQUAL expr pattern EQUAL expr
{ { peq_patt = $1; peq_expr = $3; } } { ($1, $3) }
; ;
pattern: pattern:
| IDENT { PP_var ($1) } | IDENT { [fetch_var $1] }
| LPAREN IDENT COMMA indent_comma_list RPAREN { PP_tuple ($2 :: $4) }; | LPAREN ident_comma_list_patt RPAREN { $2 };
indent_comma_list: ident_comma_list_patt:
| IDENT { [$1] } | IDENT { [fetch_var $1] }
| IDENT COMMA indent_comma_list { $1 :: $3 } | IDENT COMMA ident_comma_list_patt { (fetch_var $1) :: $3 }
expr: expr:
/* Note: PLUS, MINUS and EQUAL do not follow the nomenclature BO_ MO_, ... */ /* Note: EQUAL does not follow the nomenclature CMP_, ... */
| LPAREN expr RPAREN { $2 } | LPAREN expr RPAREN { $2 }
| IDENT { PE_Var $1 } | IDENT { EVar (fetch_var $1) }
| MO_not expr { PE_MonOp(MOp_not, $2) } /* Unary operators */
| PLUS expr { $2 } /* +e = e for all e integer expression. */ | MO_not expr { EMonOp (MOp_not, $2) }
| MINUS expr { PE_MonOp(MOp_minus, $2) } | MO_pre expr { EMonOp (MOp_pre, $2) }
| expr PLUS expr { PE_BinOp(BOp_add, $1, $3) } | MINUS expr { EMonOp (MOp_minus, $2) }
| expr MINUS expr { PE_BinOp(BOp_sub, $1, $3) } | PLUS expr { $2 }
| expr BO_mul expr { PE_BinOp(BOp_mul, $1, $3) } /* Binary operators */
| expr BO_div expr { PE_BinOp(BOp_div, $1, $3) } | expr PLUS expr { EBinOp (BOp_add, $1, $3) }
| expr BO_mod expr { PE_BinOp(BOp_mod, $1, $3) } | expr MINUS expr { EBinOp (BOp_sub, $1, $3) }
| expr BO_and expr { PE_BinOp(BOp_and, $1, $3) } | expr BO_mul expr { EBinOp (BOp_mul, $1, $3) }
| expr BO_or expr { PE_BinOp(BOp_or, $1, $3) } | expr BO_div expr { EBinOp (BOp_div, $1, $3) }
| expr EQUAL expr { PE_BinOp(BOp_eq, $1, $3) } | expr BO_mod expr { EBinOp (BOp_mod, $1, $3) }
| expr BO_neq expr { PE_BinOp(BOp_neq, $1, $3) } | expr BO_and expr { EBinOp (BOp_and, $1, $3) }
| expr BO_le expr { PE_BinOp(BOp_le, $1, $3) } | expr BO_or expr { EBinOp (BOp_or, $1, $3) }
| expr BO_lt expr { PE_BinOp(BOp_lt, $1, $3) } | expr BO_arrow expr { EBinOp (BOp_arrow, $1, $3) }
| expr BO_ge expr { PE_BinOp(BOp_ge, $1, $3) } /* Comparison operators */
| expr BO_gt expr { PE_BinOp(BOp_gt, $1, $3) } | expr EQUAL expr { EComp (COp_eq, $1, $3) }
| IF expr THEN expr ELSE expr { PE_TriOp(TOp_if, $2, $4, $6) } | expr CMP_neq expr { EComp (COp_neq, $1, $3) }
| IDENT LPAREN expr_comma_list RPAREN{ PE_app ($1, $3) } | expr CMP_le expr { EComp (COp_le, $1, $3) }
| LPAREN expr_comma_list RPAREN { PE_tuple($2) } | expr CMP_lt expr { EComp (COp_lt, $1, $3) }
| CONST_INT { PE_Const(CInt $1 ) } | expr CMP_ge expr { EComp (COp_ge, $1, $3) }
| CONST_BOOL { PE_Const(CBool $1 ) } | expr CMP_gt expr { EComp (COp_gt, $1, $3) }
| PRE expr { PE_pre $2 } /* Tertiary operators */
| expr ARROW expr { PE_arrow ($1, $3) } | IF expr THEN expr ELSE expr { ETriOp (TOp_if, $2, $4, $6) }
| TO_merge expr expr expr { ETriOp (TOp_merge, $2, $3, $4) }
/* When is neither a binop (a * 'a -> 'a) or a comp ('a * 'a -> bool) */
| WHEN expr expr { EWhen ($2, $3) }
/* Constants */
| CONST_INT { EConst (CInt $1) }
| CONST_BOOL { EConst (CBool $1) }
| CONST_REAL { EConst (CReal $1) }
/* Tuples */
| LPAREN expr_comma_list RPAREN { $2 }
/* Applications */
| IDENT LPAREN expr_comma_list RPAREN
{ let name = $1 in
let args = $3 in
EApp (fetch_node name, args) }
; ;
expr_comma_list: expr_comma_list:
| expr { [$1] } | expr
| expr COMMA expr_comma_list { $1 :: $3 } { let e = $1 in
match e with
typ: | ETuple _ -> e
| BOOL { Tbool } | _ -> ETuple [e] }
| INT { Tint } | expr COMMA expr_comma_list
{ let e = $1 in
let le = $3 in
match e, le with
| ETuple t, ETuple t' -> ETuple (t @ t')
| _, ETuple t' -> ETuple (e :: t')
| _, _ -> raise (MyParsingError "This exception should not have been \
raised.") }
; ;
ident_comma_list: ident_comma_list:

8
src/pp.ml
View File

@@ -1,5 +1,11 @@
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>"
@@ -127,4 +133,4 @@ let pp_prog fmt prog =
(List.length prog) (List.length prog)
pp_nodes prog pp_nodes prog
*)