234 lines
5.5 KiB
OCaml
234 lines
5.5 KiB
OCaml
%{
|
|
|
|
open Misc
|
|
open Signature
|
|
open Names
|
|
open Ident
|
|
open Types
|
|
open Location
|
|
open Minils
|
|
|
|
let mk_exp = mk_exp ~loc:(current_loc())
|
|
let mk_node = mk_node ~loc:(current_loc())
|
|
let mk_equation p e = mk_equation ~loc:(current_loc()) p e
|
|
let mk_type name desc = mk_type_dec ~loc:(current_loc()) ~type_desc: desc name
|
|
|
|
|
|
|
|
let mk_var name ty = mk_var_dec name ty
|
|
|
|
%}
|
|
|
|
%token DOT LPAREN RPAREN LBRACE RBRACE COLON SEMICOL
|
|
%token EQUAL EQUALEQUAL BARBAR COMMA BAR LET TEL
|
|
%token <string> CONSTRUCTOR
|
|
%token <string> NAME
|
|
%token <int> INT
|
|
%token <float> FLOAT
|
|
%token <bool> BOOL
|
|
%token <char> CHAR
|
|
%token <string> STRING
|
|
%token <string * string> PRAGMA
|
|
%token TYPE FUN NODE RETURNS VAR OPEN
|
|
%token FBY PRE SWITCH WHEN EVERY
|
|
%token OR STAR NOT
|
|
%token AMPERSAND
|
|
%token AMPERAMPER
|
|
%token AUTOMATON
|
|
%token PRESENT
|
|
%token RESET
|
|
%token STATE
|
|
%token UNLESS
|
|
%token UNTIL
|
|
%token EMIT
|
|
%token LAST
|
|
%token IF
|
|
%token THEN
|
|
%token ELSE
|
|
%token DEFAULT
|
|
%token DO
|
|
%token CONTINUE
|
|
%token CASE
|
|
%token CONTRACT
|
|
%token ASSUME
|
|
%token ENFORCE
|
|
%token WITH
|
|
%token INLINED
|
|
%token AT
|
|
%token <string> PREFIX
|
|
%token <string> INFIX0
|
|
%token <string> INFIX1
|
|
%token <string> INFIX2
|
|
%token <string> SUBTRACTIVE
|
|
%token <string> INFIX3
|
|
%token <string> INFIX4
|
|
%token EOF
|
|
|
|
|
|
%nonassoc prec_ident
|
|
%left IF ELSE
|
|
%right ARROW
|
|
%nonassoc EVERY
|
|
%left OR
|
|
%left AMPERSAND
|
|
%left INFIX0 EQUAL
|
|
%right INFIX1
|
|
%left INFIX2 SUBTRACTIVE
|
|
%left STAR INFIX3
|
|
%left INFIX4
|
|
%right prefixs
|
|
%right FBY
|
|
%right PRE
|
|
%right LAST
|
|
%right prec_apply
|
|
%left DOT
|
|
|
|
|
|
|
|
%start program
|
|
%type <Minils.program> program
|
|
|
|
%%
|
|
|
|
/*TODO deal with when merge and co*/
|
|
/*TODO add arrow ?*/
|
|
/*TODO be happy with the tools*/
|
|
|
|
/** Tools **/
|
|
|
|
/* Redefinitions */
|
|
%inline option_list(x) : l=list(x) {l}
|
|
%inline list(x) : l=nonempty_list(x) {l}
|
|
%inline option_slist(S, x) : l=separated_list(S, x) {l}
|
|
%inline slist(S, x) : l=separated_nonempty_list(S, x) {l}
|
|
|
|
%inline nuple(L, R, S, x) : L h=x S t=slist(S,x) R { h::t }
|
|
%inline stuple(S, x) : LPAREN h=x S t=slist(S,x) RPAREN { h::t }
|
|
%inline tuple(x) : t=stuple(COMMA,x) { t }
|
|
%inline option2(P,x) : /* empty */ { None } | P v=x { Some(v)}
|
|
|
|
qualified(x) :
|
|
| n=x { Name(n) } %prec prec_ident
|
|
| m=CONSTRUCTOR DOT n=x { Modname({ qual = m; id = n }) }
|
|
|
|
structure(field): s=nuple(LBRACE, RBRACE, SEMICOL, field) {s}
|
|
|
|
|
|
|
|
program:
|
|
| pragma_headers open_modules type_decs node_decs EOF
|
|
{{ p_pragmas = List.rev $1;
|
|
p_opened = List.rev $2;
|
|
p_types = $3;
|
|
p_nodes = $4;
|
|
p_consts = []}} /*TODO consts dans program*/
|
|
|
|
pragma_headers: l=option_list(pragma) {l}
|
|
pragma: p=PRAGMA {p}
|
|
|
|
open_modules: l=option_list(opens) {l}
|
|
opens: OPEN c=CONSTRUCTOR {c}
|
|
|
|
ident: n=NAME | LPAREN n=infix RPAREN | LPAREN n=prefix RPAREN { n }
|
|
|
|
field_type : n=NAME COLON t=type_ident { (n, t) }
|
|
|
|
type_ident: NAME { Tid(Name($1)) }
|
|
|
|
type_decs: t=option_list(type_dec) {t}
|
|
type_dec:
|
|
| TYPE n=NAME { mk_type n Type_abs }
|
|
| TYPE n=NAME EQUAL e=slist(BAR,NAME) { mk_type n (Type_enum e) }
|
|
| TYPE n=NAME EQUAL s=structure(field_type) { mk_type n (Type_struct s) }
|
|
|
|
node_decs: ns=option_list(node_dec) {ns}
|
|
node_dec:
|
|
NODE id=ident LPAREN args=params RPAREN RETURNS LPAREN out=params RPAREN
|
|
vars=loc_vars LET eqs=equs TEL
|
|
{ mk_node
|
|
~input: args
|
|
~output: out
|
|
~local: vars
|
|
~eq: eqs
|
|
id }
|
|
|
|
params: p=option_slist(SEMICOL, var) {p}
|
|
|
|
loc_vars:
|
|
| /* empty */ { [] }
|
|
| VAR vs=slist(SEMICOL, var) { vs }
|
|
|
|
var:
|
|
| ns=slist(COMMA, NAME) COLON t=type_ident
|
|
{ List.map (fun id -> mk_var id t) ns }
|
|
|
|
equs: e=option_slist(SEMICOL, equ) ?SEMICOL {e}
|
|
equ: p=pat EQUAL e=exp { mk_eq p e }
|
|
|
|
pat:
|
|
| n=NAME {Evarpat (ident_of_name n)}
|
|
| LPAREN p=slist(COMMA, pat) RPAREN {Etuplepat p}
|
|
|
|
longname: l=qualified(ident) {l}
|
|
|
|
constructor:
|
|
| ln=qualified(CONSTRUCTOR) {ln}
|
|
| b=BOOL { Name(if b then "true" else "false") }
|
|
|
|
const:
|
|
| INT { Cint($1) }
|
|
| FLOAT { Cfloat($1) }
|
|
| constructor { Cconstr($1) }
|
|
|
|
exps: LPAREN e=option_slist(COMMA, exp) RPAREN {e}
|
|
|
|
tuple_exp: LPAREN e=option_slist(COMMA, exp) RPAREN {e}
|
|
|
|
field_exp: longname EQUAL exp { ($1, $3) }
|
|
|
|
simple_exp:
|
|
| NAME { mk_exp (Evar (ident_of_name $1)) }
|
|
| c=const { mk_exp (Econst c) }
|
|
| s=structure(field_exp) { mk_exp (Estruct s) }
|
|
| t=tuple_exp { mk_exp (Etuple t) }
|
|
| LPAREN e=exp RPAREN { e }
|
|
|
|
exp:
|
|
| e=simple_exp { e }
|
|
| const FBY exp
|
|
{ make_exp (Efby(Some($1),$3)) }
|
|
| PRE exp
|
|
{ make_exp (Efby(None,$2)) }
|
|
| longname LPAREN exps RPAREN %prec prec_apply
|
|
{ make_exp (Eapp(make_app $1 Ino, $3)) }
|
|
| INLINED longname LPAREN exps RPAREN %prec prec_apply
|
|
{ make_exp (Eapp(make_app $2 Irec, $4)) }
|
|
| e1=exp op=infix e2=exp
|
|
{ make_exp (Eop(Name(op), [e1; e2])) }
|
|
| op=prefix e=exp %prec prefixs
|
|
{ make_exp (Eop(Name(op), [e])) }
|
|
| IF exp THEN exp ELSE exp
|
|
{ make_exp (Eifthenelse($2, $4, $6)) }
|
|
| exp DOT longname
|
|
{ make_exp (Efield($1, $3)) }
|
|
|
|
|
|
%inline infix:
|
|
| op=INFIX0 | op=INFIX1 | op=INFIX2 | op=INFIX3 | op=INFIX4 { op }
|
|
| STAR { "*" }
|
|
| EQUAL { "=" }
|
|
| EQUALEQUAL { "==" }
|
|
| AMPERSAND { "&" } | AMPERAMPER { "&&" }
|
|
| OR { "or" } | BARBAR { "||" }
|
|
|
|
prefix:
|
|
| op = PREFIX { op }
|
|
| NOT { "not" }
|
|
| op = SUBTRACTIVE { "~" ^ op } /*TODO test 3 * -2 and co */
|
|
|
|
|
|
|
|
|
|
|
|
%%
|