2022-12-07 16:45:55 +01:00
|
|
|
%{
|
2022-12-09 17:01:04 +01:00
|
|
|
open Ast
|
2022-12-09 23:18:13 +01:00
|
|
|
open Utils
|
2022-12-09 14:26:28 +01:00
|
|
|
|
2022-12-13 11:45:40 +01:00
|
|
|
let bloop () = Format.printf "bloop\n"
|
2022-12-07 16:45:55 +01:00
|
|
|
let current_location () = symbol_start_pos (), symbol_end_pos ()
|
2022-12-09 14:26:28 +01:00
|
|
|
|
2022-12-13 10:26:55 +01:00
|
|
|
let defined_nodes : (ident, t_node) Hashtbl.t = Hashtbl.create Config.maxvar
|
2022-12-09 14:26:28 +01:00
|
|
|
|
2022-12-13 15:02:54 +01:00
|
|
|
let defined_vars : (ident, t_var) Hashtbl.t = Hashtbl.create Config.maxvar
|
2022-12-09 14:26:28 +01:00
|
|
|
|
2022-12-09 17:01:04 +01:00
|
|
|
let fetch_node (n: ident) =
|
2022-12-09 14:26:28 +01:00
|
|
|
match Hashtbl.find_opt defined_nodes n with
|
|
|
|
| None ->
|
|
|
|
raise (MyParsingError
|
2022-12-09 23:18:13 +01:00
|
|
|
("The node "^n^" does not exist.", current_location()))
|
2022-12-09 14:26:28 +01:00
|
|
|
| Some node -> node
|
|
|
|
|
2022-12-09 17:01:04 +01:00
|
|
|
let fetch_var (n: ident) : t_var =
|
2022-12-09 14:26:28 +01:00
|
|
|
match Hashtbl.find_opt defined_vars n with
|
|
|
|
| None ->
|
|
|
|
raise (MyParsingError
|
2022-12-09 23:18:13 +01:00
|
|
|
("The var "^n^" does not exist.", current_location()))
|
2022-12-13 15:02:54 +01:00
|
|
|
| Some var -> var
|
2022-12-13 10:26:55 +01:00
|
|
|
|
2022-12-13 15:02:54 +01:00
|
|
|
(*
|
2022-12-13 10:26:55 +01:00
|
|
|
let fetch_var_def (n: ident) : t_var =
|
|
|
|
match Hashtbl.find_opt defined_vars n with
|
|
|
|
| None ->
|
|
|
|
raise (MyParsingError
|
|
|
|
("The var "^n^" does not exist.", current_location()))
|
|
|
|
| Some (var, true) ->
|
|
|
|
raise (MyParsingError
|
|
|
|
("The variable "^n^" is defined for the second time.",
|
|
|
|
current_location()))
|
|
|
|
| Some (var, false) ->
|
|
|
|
(Hashtbl.replace defined_vars n (var, true) ; var)
|
2022-12-13 15:02:54 +01:00
|
|
|
*)
|
2022-12-09 14:26:28 +01:00
|
|
|
|
2022-12-10 17:14:54 +01:00
|
|
|
let concat_varlist (t1, e1) (t2, e2) = (t1 @ t2, e1 @ e2)
|
2022-12-09 16:33:07 +01:00
|
|
|
|
2022-12-09 17:01:04 +01:00
|
|
|
let make_ident (v : t_var) : t_varlist =
|
2022-12-09 16:33:07 +01:00
|
|
|
match v with
|
2022-12-10 17:14:54 +01:00
|
|
|
| IVar _ -> [TInt ], [v]
|
|
|
|
| BVar _ -> [TBool], [v]
|
|
|
|
| RVar _ -> [TReal], [v]
|
2022-12-09 16:33:07 +01:00
|
|
|
|
2022-12-09 17:01:04 +01:00
|
|
|
let add_ident (v : t_var) (l: t_varlist) : t_varlist =
|
2022-12-09 16:33:07 +01:00
|
|
|
match v, l with
|
2022-12-10 17:14:54 +01:00
|
|
|
| IVar _, (tl, l) -> ((TInt :: tl), v :: l)
|
|
|
|
| BVar _, (tl, l) -> ((TBool :: tl), v :: l)
|
|
|
|
| RVar _, (tl, l) -> ((TReal :: tl), v :: l)
|
2022-12-10 00:00:17 +01:00
|
|
|
|
|
|
|
let monop_condition expr typ_constraint error_msg res =
|
|
|
|
if type_exp expr = typ_constraint
|
|
|
|
then res
|
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
|
|
|
|
|
|
|
let monop_neg_condition expr typ_constraint error_msg res =
|
|
|
|
if type_exp expr <> typ_constraint
|
|
|
|
then res
|
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
|
|
|
|
|
|
|
let make_binop_nonbool e1 e2 op error_msg =
|
|
|
|
let t1 = type_exp e1 in let t2 = type_exp e2 in
|
2022-12-10 17:14:54 +01:00
|
|
|
(** e1 and e2 should be nunmbers here.*)
|
|
|
|
if list_chk t1 [[TInt]; [TReal]] && list_chk t2 [[TInt]; [TReal]]
|
|
|
|
then
|
|
|
|
begin
|
|
|
|
if t1 = t2
|
|
|
|
then EBinOp (t1, op, e1, e2)
|
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
|
|
|
end
|
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
2022-12-10 00:00:17 +01:00
|
|
|
|
|
|
|
let make_binop_bool e1 e2 op error_msg =
|
|
|
|
let t1 = type_exp e1 in let t2 = type_exp e2 in
|
2022-12-10 17:14:54 +01:00
|
|
|
if t1 = t2 && t1 = [TBool]
|
2022-12-10 00:00:17 +01:00
|
|
|
then EBinOp (t1, op, e1, e2)
|
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
|
|
|
|
|
|
|
let make_comp e1 e2 op error_msg =
|
|
|
|
let t1 = type_exp e1 in let t2 = type_exp e2 in
|
2022-12-10 17:14:54 +01:00
|
|
|
(** e1 and e2 should not be tuples *)
|
|
|
|
if t1 = t2 && List.length t1 = 1
|
|
|
|
then EComp ([TBool], op, e1, e2)
|
2022-12-10 00:00:17 +01:00
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
|
|
|
|
|
|
|
let make_comp_nonbool e1 e2 op error_msg =
|
|
|
|
let t1 = type_exp e1 in let t2 = type_exp e2 in
|
2022-12-10 17:14:54 +01:00
|
|
|
(** e1 and e2 should be nunmbers here.*)
|
|
|
|
if list_chk t1 [[TInt]; [TReal]] && list_chk t2 [[TInt]; [TReal]]
|
|
|
|
then
|
|
|
|
begin
|
|
|
|
if t1 = t2
|
|
|
|
then EComp ([TBool], op, e1, e2)
|
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
|
|
|
end
|
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
2022-12-10 00:00:17 +01:00
|
|
|
|
|
|
|
let make_tertiary e1 e2 e3 op error_msg =
|
|
|
|
let t1 = type_exp e1 in let t2 = type_exp e2 in let t3 = type_exp e3 in
|
2022-12-10 17:14:54 +01:00
|
|
|
if t2 = t3 && t1 = [TBool]
|
2022-12-10 00:00:17 +01:00
|
|
|
then ETriOp (t2, op, e1, e2, e3)
|
|
|
|
else raise (MyParsingError (error_msg, current_location()))
|
|
|
|
|
2022-12-07 16:45:55 +01:00
|
|
|
%}
|
|
|
|
|
|
|
|
%token EOF
|
|
|
|
%token<string> IDENT
|
|
|
|
%token LPAREN
|
|
|
|
%token RPAREN
|
|
|
|
%token RETURNS
|
|
|
|
%token SEMICOL
|
|
|
|
%token COLON
|
|
|
|
%token BOOL
|
|
|
|
%token INT
|
Make `real` type works
Otherwise for the following code:
```
node test (i: real) returns (o: real);
let
o = 0.0;
tel
```
was experiencing:
```
Fatal error: exception Stdlib.Parsing.Parse_error
Raised at Stdlib__Parsing.yyparse.loop in file "parsing.ml", line 139, characters 8-25
Called from Stdlib__Parsing.yyparse in file "parsing.ml", line 165, characters 4-28
Re-raised at Stdlib__Parsing.yyparse in file "parsing.ml", line 184, characters 8-17
Called from Parser.main in file "parser.ml" (inlined), line 1110, characters 4-44
Called from Main in file "main.ml", line 70, characters 16-68
```
Note that `%token REAL` doesn't help to solve this error, but it doesn't seem to be any reason for not having it.
2022-12-10 00:05:07 +01:00
|
|
|
%token REAL
|
2022-12-07 16:45:55 +01:00
|
|
|
%token LET
|
|
|
|
%token TEL
|
|
|
|
%token NODE
|
|
|
|
%token VAR
|
|
|
|
%token EQUAL
|
|
|
|
%token COMMA
|
2022-12-09 14:26:28 +01:00
|
|
|
%token<Ast.base_ty> TYP
|
2022-12-07 21:56:38 +01:00
|
|
|
|
|
|
|
%token MO_not
|
2022-12-09 14:26:28 +01:00
|
|
|
%token MO_pre
|
|
|
|
%token PLUS
|
|
|
|
%token MINUS
|
2022-12-07 21:56:38 +01:00
|
|
|
%token BO_and
|
|
|
|
%token BO_or
|
|
|
|
%token BO_mul
|
|
|
|
%token BO_div
|
2022-12-09 14:26:28 +01:00
|
|
|
%token BO_mod
|
|
|
|
%token BO_arrow
|
2022-12-09 23:18:13 +01:00
|
|
|
%token BO_fby
|
2022-12-09 14:26:28 +01:00
|
|
|
%token CMP_le
|
|
|
|
%token CMP_lt
|
|
|
|
%token CMP_ge
|
|
|
|
%token CMP_gt
|
|
|
|
%token CMP_neq
|
|
|
|
%token TO_merge
|
2022-12-07 21:56:38 +01:00
|
|
|
|
2022-12-09 14:26:28 +01:00
|
|
|
%token WHEN
|
2022-12-10 02:18:04 +01:00
|
|
|
%token RESET
|
2022-12-07 21:56:38 +01:00
|
|
|
|
|
|
|
%token IF
|
|
|
|
%token THEN
|
|
|
|
%token ELSE
|
|
|
|
|
2022-12-13 11:45:40 +01:00
|
|
|
%token AUTOMAT
|
|
|
|
%token CASE
|
|
|
|
%token MATCH
|
|
|
|
%token WITH
|
|
|
|
%token DO
|
|
|
|
%token DONE
|
|
|
|
%token UNTIL
|
|
|
|
|
2022-12-07 21:56:38 +01:00
|
|
|
%token<int> CONST_INT
|
|
|
|
%token<bool> CONST_BOOL
|
2022-12-09 14:26:28 +01:00
|
|
|
%token<Ast.real> CONST_REAL
|
2022-12-07 16:45:55 +01:00
|
|
|
|
2022-12-15 09:13:28 +01:00
|
|
|
%left MO_not
|
|
|
|
%left MO_pre
|
|
|
|
%left PLUS
|
|
|
|
%left MINUS
|
|
|
|
%left BO_and BO_or BO_mul BO_div BO_mod BO_arrow BO_fby TO_merge
|
|
|
|
|
2022-12-07 16:45:55 +01:00
|
|
|
/* The Entry Point */
|
|
|
|
%start main
|
2022-12-09 14:26:28 +01:00
|
|
|
%type <Ast.t_nodelist> main
|
2022-12-07 16:45:55 +01:00
|
|
|
|
|
|
|
%%
|
|
|
|
|
|
|
|
main: nodes EOF { $1 };
|
|
|
|
|
|
|
|
nodes:
|
|
|
|
| /* empty */ { [] }
|
|
|
|
| node nodes { $1 :: $2 };
|
|
|
|
|
|
|
|
node:
|
2022-12-08 17:52:19 +01:00
|
|
|
NODE node_content
|
|
|
|
{ (* Flush known variables *) Hashtbl.clear defined_vars; $2 }
|
2022-12-09 14:26:28 +01:00
|
|
|
|
|
|
|
node_content:
|
|
|
|
IDENT LPAREN in_params RPAREN
|
2022-12-10 01:58:09 +01:00
|
|
|
RETURNS LPAREN out_params RPAREN OPTIONAL_SEMICOL
|
2022-12-07 16:45:55 +01:00
|
|
|
local_params
|
2022-12-13 15:02:54 +01:00
|
|
|
LET node_body TEL OPTIONAL_SEMICOL
|
2022-12-09 15:47:27 +01:00
|
|
|
{ let node_name = $1 in
|
2022-12-13 15:02:54 +01:00
|
|
|
let (eqs, aut) = $12 in
|
2022-12-09 16:33:07 +01:00
|
|
|
let (t_in, e_in) = $3 in
|
|
|
|
let (t_out, e_out) = $7 in
|
2022-12-08 17:52:19 +01:00
|
|
|
let n: t_node =
|
2022-12-09 15:47:27 +01:00
|
|
|
{ n_name = node_name;
|
2022-12-09 16:33:07 +01:00
|
|
|
n_inputs = (t_in, e_in);
|
|
|
|
n_outputs = (t_out, e_out);
|
2022-12-09 15:47:27 +01:00
|
|
|
n_local_vars = $10;
|
2022-12-13 15:02:54 +01:00
|
|
|
n_equations = eqs;
|
2022-12-15 18:33:04 +01:00
|
|
|
n_automata = aut; } in
|
2022-12-16 00:00:11 +01:00
|
|
|
if List.length t_in = 0
|
2022-12-14 18:41:59 +01:00
|
|
|
then raise (MyParsingError
|
2022-12-15 22:14:59 +01:00
|
|
|
(Format.asprintf "The node %s should have arguments."
|
|
|
|
node_name,
|
2022-12-14 18:41:59 +01:00
|
|
|
current_location()))
|
2022-12-15 21:42:21 +01:00
|
|
|
else
|
2022-12-15 22:14:59 +01:00
|
|
|
begin
|
|
|
|
if Hashtbl.find_opt defined_nodes node_name <> None
|
|
|
|
then raise (MyParsingError
|
|
|
|
(Format.asprintf "The node %s is already defined."
|
|
|
|
node_name,
|
|
|
|
current_location()))
|
|
|
|
else
|
|
|
|
if vars_distinct e_in e_out (snd $10)
|
|
|
|
then (Hashtbl.add defined_nodes node_name n; n)
|
|
|
|
else raise (MyParsingError
|
|
|
|
("There is a conflict between the names of local, input \
|
|
|
|
or output variables.",
|
|
|
|
current_location()))
|
|
|
|
end};
|
2022-12-07 16:45:55 +01:00
|
|
|
|
2022-12-13 15:02:54 +01:00
|
|
|
node_body:
|
|
|
|
| /* empty */ { ([], []) }
|
|
|
|
| equations node_body { let (eq, aut) = $2 in ($1@eq, aut) }
|
|
|
|
| automaton node_body { let (eq, aut) = $2 in (eq, $1::aut) }
|
|
|
|
|
2022-12-10 01:58:09 +01:00
|
|
|
OPTIONAL_SEMICOL:
|
|
|
|
| /* empty */ {}
|
|
|
|
| SEMICOL {}
|
|
|
|
;
|
|
|
|
|
2022-12-07 16:45:55 +01:00
|
|
|
in_params:
|
2022-12-10 17:14:54 +01:00
|
|
|
| /* empty */ { ([], []) }
|
2022-12-07 16:45:55 +01:00
|
|
|
| param_list { $1 }
|
2022-12-09 14:26:28 +01:00
|
|
|
;
|
2022-12-07 16:45:55 +01:00
|
|
|
|
|
|
|
out_params: param_list { $1 } ;
|
|
|
|
|
|
|
|
local_params:
|
2022-12-10 17:14:54 +01:00
|
|
|
| /* empty */ { ([], []) }
|
2022-12-07 16:45:55 +01:00
|
|
|
| VAR param_list_semicol { $2 }
|
|
|
|
;
|
|
|
|
|
|
|
|
param_list_semicol:
|
2022-12-09 15:47:27 +01:00
|
|
|
| param SEMICOL { $1 }
|
2022-12-09 16:33:07 +01:00
|
|
|
| param SEMICOL param_list_semicol { concat_varlist $1 $3 }
|
2022-12-07 16:45:55 +01:00
|
|
|
|
|
|
|
param_list:
|
|
|
|
| param { $1 }
|
2022-12-09 16:33:07 +01:00
|
|
|
| param SEMICOL param_list { concat_varlist $1 $3 }
|
2022-12-07 16:45:55 +01:00
|
|
|
;
|
|
|
|
|
|
|
|
param:
|
2022-12-09 14:26:28 +01:00
|
|
|
ident_comma_list COLON TYP
|
|
|
|
{ let typ = $3 in
|
|
|
|
let idents = $1 in
|
2022-12-10 17:14:54 +01:00
|
|
|
(list_repeat (List.length idents) typ,
|
2022-12-09 14:26:28 +01:00
|
|
|
match typ with
|
|
|
|
| TBool ->
|
2022-12-13 10:26:55 +01:00
|
|
|
List.map (fun s ->
|
2022-12-13 15:02:54 +01:00
|
|
|
Hashtbl.add defined_vars s (BVar s); BVar s) idents
|
2022-12-09 14:26:28 +01:00
|
|
|
| TReal ->
|
2022-12-13 10:26:55 +01:00
|
|
|
List.map (fun s ->
|
2022-12-13 15:02:54 +01:00
|
|
|
Hashtbl.add defined_vars s (RVar s); RVar s) idents
|
2022-12-09 14:26:28 +01:00
|
|
|
| TInt ->
|
2022-12-13 10:26:55 +01:00
|
|
|
List.map (fun s ->
|
2022-12-13 15:02:54 +01:00
|
|
|
Hashtbl.add defined_vars s (IVar s); IVar s) idents) }
|
2022-12-07 16:45:55 +01:00
|
|
|
;
|
|
|
|
|
2022-12-09 14:26:28 +01:00
|
|
|
ident_comma_list:
|
|
|
|
| IDENT { [$1] }
|
|
|
|
| IDENT COMMA ident_comma_list { $1 :: $3 }
|
|
|
|
|
2022-12-07 16:45:55 +01:00
|
|
|
equations:
|
|
|
|
| /* empty */ { [] }
|
|
|
|
| equation SEMICOL equations
|
2022-12-09 15:47:27 +01:00
|
|
|
{ $1 :: $3 }
|
2022-12-16 05:57:25 +01:00
|
|
|
| equation OPTIONAL_SEMICOL { [$1] }
|
2022-12-07 16:45:55 +01:00
|
|
|
;
|
|
|
|
|
|
|
|
equation:
|
2022-12-13 15:02:54 +01:00
|
|
|
| pattern EQUAL expr
|
2022-12-08 17:52:19 +01:00
|
|
|
{ let (t_patt, patt) = $1 in
|
2022-12-10 00:33:14 +01:00
|
|
|
let expr = $3 in let texpr = type_exp expr in
|
2022-12-10 17:14:54 +01:00
|
|
|
if t_patt = texpr
|
2022-12-08 17:52:19 +01:00
|
|
|
then ((t_patt, patt), expr)
|
2022-12-10 17:20:02 +01:00
|
|
|
else (raise (MyParsingError ("The equation does not type check!",
|
2022-12-10 00:33:14 +01:00
|
|
|
current_location()))) };
|
2022-12-13 15:02:54 +01:00
|
|
|
automaton:
|
|
|
|
| AUTOMAT transition_list { (List.hd $2, $2)}
|
|
|
|
;
|
2022-12-07 16:45:55 +01:00
|
|
|
|
2022-12-07 21:56:38 +01:00
|
|
|
pattern:
|
2022-12-09 16:33:07 +01:00
|
|
|
| IDENT
|
2022-12-13 15:02:54 +01:00
|
|
|
{ let v = fetch_var $1 in (type_var v, [v]) }
|
2022-12-09 14:26:28 +01:00
|
|
|
| LPAREN ident_comma_list_patt RPAREN { $2 };
|
2022-12-07 21:56:38 +01:00
|
|
|
|
2022-12-09 14:26:28 +01:00
|
|
|
ident_comma_list_patt:
|
2022-12-13 15:02:54 +01:00
|
|
|
| IDENT { make_ident (fetch_var $1) }
|
|
|
|
| IDENT COMMA ident_comma_list_patt { add_ident (fetch_var $1) $3 }
|
2022-12-07 21:56:38 +01:00
|
|
|
|
|
|
|
expr:
|
2022-12-09 14:26:28 +01:00
|
|
|
/* Note: EQUAL does not follow the nomenclature CMP_, ... */
|
2022-12-07 21:56:38 +01:00
|
|
|
| LPAREN expr RPAREN { $2 }
|
2022-12-09 17:01:04 +01:00
|
|
|
| IDENT { let v = fetch_var $1 in EVar (type_var v, v) }
|
2022-12-09 14:26:28 +01:00
|
|
|
/* Unary operators */
|
2022-12-09 23:18:13 +01:00
|
|
|
| MO_not expr
|
2022-12-10 17:14:54 +01:00
|
|
|
{ monop_condition $2 [TBool]
|
2022-12-10 00:00:17 +01:00
|
|
|
"You cannot negate a non-boolean expression."
|
|
|
|
(EMonOp (type_exp $2, MOp_not, $2)) }
|
2022-12-09 17:01:04 +01:00
|
|
|
| MO_pre expr { EMonOp (type_exp $2, MOp_pre, $2) }
|
2022-12-09 23:18:13 +01:00
|
|
|
| MINUS expr
|
2022-12-10 17:14:54 +01:00
|
|
|
{ monop_neg_condition $2 [TBool]
|
2022-12-10 00:00:17 +01:00
|
|
|
"You cannot take the opposite of a boolean expression."
|
|
|
|
(EMonOp (type_exp $2, MOp_minus, $2)) }
|
2022-12-09 23:18:13 +01:00
|
|
|
| PLUS expr
|
2022-12-10 17:14:54 +01:00
|
|
|
{ monop_neg_condition $2 [TBool]
|
2022-12-10 00:00:17 +01:00
|
|
|
"You cannot take the plus of a boolean expression." $2 }
|
2022-12-09 14:26:28 +01:00
|
|
|
/* Binary operators */
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr PLUS expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_binop_nonbool $1 $3 BOp_add
|
|
|
|
"You should know better; addition hates booleans" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr MINUS expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_binop_nonbool $1 $3 BOp_sub
|
|
|
|
"You should know better; subtraction hates booleans" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr BO_mul expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_binop_nonbool $1 $3 BOp_mul
|
|
|
|
"You should know better; multiplication hates booleans" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr BO_div expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_binop_nonbool $1 $3 BOp_div
|
|
|
|
"You should know better; division hates booleans" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr BO_mod expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_binop_nonbool $1 $3 BOp_mod
|
|
|
|
"You should know better; modulo hates booleans" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr BO_and expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_binop_bool $1 $3 BOp_and
|
|
|
|
"You should know better; conjunction hates numbers" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr BO_or expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_binop_bool $1 $3 BOp_or
|
|
|
|
"You should know better; disjunction hates numbers" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr BO_arrow expr
|
|
|
|
{ let e1 = $1 in let t1 = type_exp e1 in
|
|
|
|
let e2 = $3 in let t2 = type_exp e2 in
|
|
|
|
if t1 = t2
|
|
|
|
then EBinOp (type_exp $1, BOp_arrow, $1, $3)
|
|
|
|
else raise (MyParsingError ("The -> does not type-check",
|
|
|
|
current_location())) }
|
|
|
|
/* Binary operators, syntactic sugar */
|
|
|
|
| expr BO_fby expr
|
|
|
|
{ (* e fby e' ==> e -> (pre e') *)
|
2022-12-10 00:00:17 +01:00
|
|
|
let e1 = $1 in let t1 = type_exp e1 in
|
|
|
|
let e2 = $3 in let t2 = type_exp e2 in
|
|
|
|
if t1 = t2
|
|
|
|
then EBinOp (t1, BOp_arrow, e1, (EMonOp (t1, MOp_pre, e2)))
|
2022-12-09 23:18:13 +01:00
|
|
|
else raise (MyParsingError ("The fby does not type-check!",
|
|
|
|
current_location())) }
|
2022-12-09 14:26:28 +01:00
|
|
|
/* Comparison operators */
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr EQUAL expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_comp $1 $3 COp_eq "The equality does not type-check!" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr CMP_neq expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_comp $1 $3 COp_neq "The inquality does not type-check!" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr CMP_le expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_comp_nonbool $1 $3 COp_le "The comparison <= does not type-check!" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr CMP_lt expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_comp_nonbool $1 $3 COp_lt "The comparison < does not type-check!" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr CMP_ge expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_comp_nonbool $1 $3 COp_ge "The comparison >= does not type-check!" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr CMP_gt expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_comp_nonbool $1 $3 COp_gt "The comparison > does not type-check!" }
|
2022-12-09 14:26:28 +01:00
|
|
|
/* Tertiary operators */
|
2022-12-09 23:18:13 +01:00
|
|
|
| IF expr THEN expr ELSE expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_tertiary $2 $4 $6 TOp_if "The if-then-else does not type-check!" }
|
2022-12-09 23:18:13 +01:00
|
|
|
| TO_merge expr expr expr
|
2022-12-10 00:00:17 +01:00
|
|
|
{ make_tertiary $2 $3 $4 TOp_merge "The merge does not type-check!" }
|
2022-12-09 14:26:28 +01:00
|
|
|
/* When is neither a binop (a * 'a -> 'a) or a comp ('a * 'a -> bool) */
|
2022-12-09 23:18:13 +01:00
|
|
|
| expr WHEN expr
|
|
|
|
{ let e1 = $1 in let t1 = type_exp e1 in
|
|
|
|
let e2 = $3 in let t2 = type_exp e2 in
|
2022-12-10 17:14:54 +01:00
|
|
|
if t2 = [TBool]
|
2022-12-13 14:25:48 +01:00
|
|
|
then EWhen (t1, e1, e2)
|
2022-12-09 23:18:13 +01:00
|
|
|
else raise (MyParsingError ("The when does not type-check!",
|
|
|
|
current_location())) }
|
2022-12-10 02:18:04 +01:00
|
|
|
| expr RESET expr
|
|
|
|
{ let e1 = $1 in let t1 = type_exp e1 in
|
|
|
|
let e2 = $3 in let t2 = type_exp e2 in
|
2022-12-10 17:14:54 +01:00
|
|
|
if t2 = [TBool]
|
2022-12-13 14:25:48 +01:00
|
|
|
then EReset (t1, e1, e2)
|
2022-12-10 02:18:04 +01:00
|
|
|
else raise (MyParsingError ("The reset does not type-check!",
|
|
|
|
current_location())) }
|
2022-12-09 14:26:28 +01:00
|
|
|
/* Constants */
|
2022-12-10 17:14:54 +01:00
|
|
|
| CONST_INT { EConst ([TInt], CInt $1) }
|
|
|
|
| CONST_BOOL { EConst ([TBool], CBool $1) }
|
|
|
|
| CONST_REAL { EConst ([TReal], CReal $1) }
|
2022-12-09 14:26:28 +01:00
|
|
|
/* Tuples */
|
|
|
|
| LPAREN expr_comma_list RPAREN { $2 }
|
|
|
|
/* Applications */
|
2022-12-15 22:07:16 +01:00
|
|
|
| IDENT LPAREN RPAREN
|
|
|
|
{ raise (MyParsingError ("An application should come with arguments!",
|
|
|
|
current_location())) }
|
2022-12-09 14:26:28 +01:00
|
|
|
| IDENT LPAREN expr_comma_list RPAREN
|
|
|
|
{ let name = $1 in
|
2022-12-09 17:01:04 +01:00
|
|
|
let node = fetch_node name in
|
2022-12-09 14:26:28 +01:00
|
|
|
let args = $3 in
|
2022-12-15 18:33:04 +01:00
|
|
|
if type_exp args = fst node.n_inputs
|
|
|
|
then EApp (fst node.n_outputs, fetch_node name, args)
|
2022-12-10 17:14:54 +01:00
|
|
|
else raise (MyParsingError ("The application does not type check!",
|
2022-12-09 23:18:13 +01:00
|
|
|
current_location()))
|
2022-12-09 17:01:04 +01:00
|
|
|
}
|
2022-12-13 15:02:54 +01:00
|
|
|
|
|
|
|
/* Automaton */
|
2022-12-07 21:56:38 +01:00
|
|
|
;
|
|
|
|
|
|
|
|
expr_comma_list:
|
2022-12-09 14:26:28 +01:00
|
|
|
| expr
|
|
|
|
{ let e = $1 in
|
|
|
|
match e with
|
|
|
|
| ETuple _ -> e
|
2022-12-10 17:14:54 +01:00
|
|
|
| _ -> ETuple (type_exp e, [e]) }
|
2022-12-09 14:26:28 +01:00
|
|
|
| expr COMMA expr_comma_list
|
|
|
|
{ let e = $1 in
|
|
|
|
let le = $3 in
|
|
|
|
match e, le with
|
2022-12-10 17:14:54 +01:00
|
|
|
| ETuple (l1, t), ETuple (l2, t') -> ETuple (l1 @ l2, t @ t')
|
|
|
|
| _, ETuple (lt, t') -> ETuple (((type_exp e) @ lt), e :: t')
|
2022-12-09 23:18:13 +01:00
|
|
|
| _, _ -> raise (MyParsingError ("This exception should not have been \
|
|
|
|
raised.",
|
|
|
|
current_location())) }
|
2022-12-07 16:45:55 +01:00
|
|
|
;
|
|
|
|
|
|
|
|
ident_comma_list:
|
|
|
|
| IDENT { [$1] }
|
|
|
|
| IDENT COMMA ident_comma_list { $1 :: $3 }
|
|
|
|
;
|
|
|
|
|
2022-12-13 11:45:40 +01:00
|
|
|
transition:
|
|
|
|
| CASE IDENT BO_arrow DO equations DONE {
|
|
|
|
State($2, $5, EConst([TBool], CBool(true)), $2) }
|
|
|
|
| CASE IDENT BO_arrow DO equations UNTIL expr THEN IDENT {
|
|
|
|
State($2, $5, $7, $9)}
|
|
|
|
;
|
|
|
|
|
|
|
|
transition_list:
|
|
|
|
| transition { [$1] }
|
|
|
|
| transition transition_list { $1 :: $2 }
|
2022-12-13 15:02:54 +01:00
|
|
|
| /* empty */ {raise(MyParsingError("Empty automaton", current_location()))}
|
2022-12-13 11:45:40 +01:00
|
|
|
;
|