diff --git a/compiler/minils/parsing/mls_lexer.mll b/compiler/minils/parsing/mls_lexer.mll index 6057d49..8cc5c82 100644 --- a/compiler/minils/parsing/mls_lexer.mll +++ b/compiler/minils/parsing/mls_lexer.mll @@ -25,6 +25,7 @@ List.iter (fun (str,tok) -> Hashtbl.add keyword_table str tok) [ "tel", TEL; "fby", FBY; "when", WHEN; + "merge", MERGE; "type", TYPE; "true", BOOL(true); "false", BOOL(false); @@ -36,6 +37,10 @@ List.iter (fun (str,tok) -> Hashtbl.add keyword_table str tok) [ "if", IF; "then", THEN; "else", ELSE; + "with", WITH; + "map", MAP; + "fold", FOLD; + "mapfold", MAPFOLD; "quo", INFIX3("quo"); "mod", INFIX3("mod"); "land", INFIX3("land"); @@ -102,11 +107,14 @@ let char_for_decimal_code lexbuf i = rule token = parse | [' ' '\010' '\013' '\009' '\012'] + { token lexbuf } | "." {DOT} + | ".." {DOTDOT} | "(" {LPAREN} | ")" {RPAREN} | "*" { STAR } | "{" {LBRACE} | "}" {RBRACE} + | "[" {LBRACKET} + | "]" {RBRACKET} | ":" {COLON} | ";" {SEMICOL} | "=" {EQUAL} @@ -115,10 +123,12 @@ rule token = parse | "&&" {AMPERAMPER} | "||" {BARBAR} | "," {COMMA} -(* | "->" {ARROW} *) + | "->" {ARROW} | "|" {BAR} | "-" {SUBTRACTIVE "-"} | "-." {SUBTRACTIVE "-."} + | "^" {POWER} + | "@" {AROBASE} | "<<" {DOUBLE_LESS} | ">>" {DOUBLE_GREATER} | (['A'-'Z']('_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9']) * as id) diff --git a/compiler/minils/parsing/mls_parser.mly b/compiler/minils/parsing/mls_parser.mly index f02540b..8770cfd 100644 --- a/compiler/minils/parsing/mls_parser.mly +++ b/compiler/minils/parsing/mls_parser.mly @@ -32,10 +32,16 @@ let mk_var name ty = mk_var_dec name ty %token AMPERSAND %token AMPERAMPER %token RESET -%token IF -%token THEN -%token ELSE +%token IF THEN ELSE %token DOUBLE_LESS DOUBLE_GREATER +%token ARROW +%token MERGE +%token POWER +%token AROBASE +%token WITH +%token DOTDOT +%token LBRACKET RBRACKET +%token MAP FOLD MAPFOLD %token PREFIX %token INFIX0 %token INFIX1 @@ -45,9 +51,8 @@ let mk_var name ty = mk_var_dec name ty %token INFIX4 %token EOF - +%right AROBASE %left ELSE - %left OR %left AMPERSAND %left INFIX0 EQUAL @@ -55,32 +60,25 @@ let mk_var name ty = mk_var_dec name ty %left INFIX2 prefixs %left STAR INFIX3 %left INFIX4 +%left WHEN %right FBY %right PRE - +%left POWER %start program %type program %% - -/*TODO deal with when merge and co*/ -/*TODO add arrow ?*/ -/*TODO be happy with the tools*/ +/*TODO add arrow (init) ?*/ /** Tools **/ - -/* Redefinitions */ %inline slist(S, x) : l=separated_list(S, x) {l} %inline snlist(S, x) : l=separated_nonempty_list(S, x) {l} %inline tuple(x) : LPAREN h=x COMMA t=snlist(COMMA,x) RPAREN { h::t } %inline option(P,x): |/* empty */ { None } | P v=x { Some(v) } -%inline option2(L,x,R): - |/* empty */ { None } - | L v=x R { Some(v) } qualified(x) : | n=x { Name(n) } @@ -90,7 +88,7 @@ structure(field): LBRACE s=snlist(SEMICOL,field) RBRACE {s} program: - | pragma_headers open_modules type_decs node_decs EOF + | pragma_headers open_modules type_decs node_decs EOF /*TODO const decs */ {{ p_pragmas = List.rev $1; p_opened = List.rev $2; p_types = $3; @@ -142,9 +140,9 @@ pat: | n=NAME {Evarpat (ident_of_name n)} | LPAREN p=snlist(COMMA, pat) RPAREN {Etuplepat p} -longname: l=qualified(name) {l} +longname: l=qualified(name) {l} /* qualified var (not a constructor) */ -constructor: +constructor: /* of type longname */ | ln=qualified(CONSTRUCTOR) {ln} | b=BOOL { Name(if b then "true" else "false") } @@ -168,19 +166,51 @@ exp: | c=const { mk_exp (Econst c) } | const FBY exp { mk_exp (Efby(Some($1),$3)) } | PRE exp { mk_exp (Efby(None,$2)) } - | op=node_app a=exps r=reset { mk_exp (Ecall(op, a, r)) } + | op=funop a=exps r=reset { mk_exp (Ecall(op, a, r)) } | e1=exp i_op=infix e2=exp { mk_exp (Ecall(mk_op ~op_kind:Efun i_op, [e1; e2], None)) } | p_op=prefix e=exp %prec prefixs { mk_exp (Ecall(mk_op ~op_kind:Efun p_op, [e], None)) } | IF e1=exp THEN e2=exp ELSE e3=exp { mk_exp (Eifthenelse(e1, e2, e3)) } | e=simple_exp DOT m=longname { mk_exp (Efield(e, m)) } + | e=exp WHEN c=constructor LPAREN n=ident RPAREN + { mk_exp (Ewhen(e, c, n)) } + | MERGE n=ident h=handlers { mk_exp (Emerge(n, h)) } + | LPAREN r=exp WITH DOT ln=longname EQUAL nv=exp /*ordre louche...*/ + { mk_exp (Efield_update(ln, r, nv)) } + | op=array_op { mk_exp (Earray_op op) } +/* ??? TODO | Earray of exp list [e1,e2,e3...] ???? */ + +array_op: /* TODO quel vrai gain de séparer les array op ? gain pour cédric ?*/ + | e=exp POWER p=e_param { Erepeat(p, e) } /*ordre louche...*/ + | e=simple_exp i=indexes { Eselect(i, e) } /*ordre louche...*/ +/*TODO | e=exp i=indexes_dyn DEFAULT d=exp { Eselect_dyn(i,???? ,e ,d) } */ + | LPAREN e=exp WITH i=indexes EQUAL nv=exp { Eupdate(i, e, nv) } /*ordre louche...*/ + | e=simple_exp LBRACKET i1=e_param DOTDOT i2=e_param RBRACKET + { Eselect_slice(i1, i2, e) } + | e1=exp AROBASE e2=exp { Econcat(e1,e2) } + | LPAREN f=iterator LPAREN op=funop RPAREN + DOUBLE_LESS p=e_param DOUBLE_GREATER /* une seule dimension ? */ + RPAREN a=exps r=reset { Eiterator(f,op,p,a,r) } + +/* Static indexes [p1][p2]... */ +indexes: is=nonempty_list(index) { is } +index: LBRACKET p=e_param RBRACKET { p } +/* Merge handlers ( B -> e)( C -> ec)... */ +handlers: hs=nonempty_list(handler) { hs } +handler: LPAREN c=constructor ARROW e=exp RPAREN { c,e } + + +iterator: + | MAP { Imap } + | FOLD { Ifold } + | MAPFOLD { Imapfold } reset: r=option(RESET,ident) { r } -node_app: ln=longname p=params(e_param) { mk_op ~op_kind:Enode ~op_params:p ln } +funop: ln=longname p=params(e_param) { mk_op ~op_kind:Enode ~op_params:p ln } e_param: e=exp { size_exp_of_exp e }