462 lines
11 KiB
OCaml
462 lines
11 KiB
OCaml
%{ (* -*- tuareg -*- *)
|
|
|
|
open HopixAST
|
|
(* open Position *)
|
|
|
|
%}
|
|
|
|
%token EOF LET TYPE WILDCARD STAR ARROW COLON EXTERN FUN COMMA AND EQUAL LPAREN
|
|
%token RPAREN LBRACK RBRACK LBRACE RBRACE INFERIOR SUPERIOR BINOP DO ELSE FOR
|
|
%token FROM IF MATCH PIPE REF THEN TO UNTIL WHILE AND_KW DOT SEMICOLON BACKSLASH
|
|
%token ASSIGN EXCLA
|
|
|
|
%token<Mint.t> INT
|
|
%token<string> ID TID CID STRING
|
|
%token<char> CHAR
|
|
|
|
%start<HopixAST.t> program
|
|
|
|
%right PIPE
|
|
|
|
%%
|
|
|
|
|
|
/********************************** PROGRAM ***********************************/
|
|
program:
|
|
/* Programme */
|
|
| definition=located(definition)* EOF {
|
|
definition
|
|
}
|
|
/* Attrapes les erreurs de syntaxe */
|
|
| e=located(error) {
|
|
Error.error "parsing" (Position.position e) "Syntax error."
|
|
}
|
|
|
|
|
|
definition:
|
|
/* Définition de types */
|
|
// Manque le 'type_variable located list' ici, on met une liste vide en attendant
|
|
| TYPE tc=located(type_constructor) EQUAL td=tdefinition {
|
|
DefineType (tc, [], td)
|
|
}
|
|
/* Valeurs externes */
|
|
| EXTERN id=located(identifier) ts=located(type_scheme) {
|
|
DeclareExtern(id, ts)
|
|
}
|
|
/* Définition de valeurs */
|
|
| v=vdefinition {
|
|
DefineValue v
|
|
}
|
|
|
|
|
|
tdefinition:
|
|
/* Type sommes */
|
|
/* | option(PIPE) type_constructor option() separated_nonempty_list(COMMA, ty) {
|
|
DefineSumType()
|
|
} */
|
|
/* Type produit étiqueté */
|
|
| LBRACE lt=separated_nonempty_list(COMMA, label_with_type) RBRACE {
|
|
DefineRecordType(lt)
|
|
}
|
|
|
|
label_with_type:
|
|
| l=located(label) COLON t=located(ty) {
|
|
l, t
|
|
}
|
|
|
|
|
|
vdefinition:
|
|
/* Valeur simple */
|
|
| LET i=located(identifier) ts=option(vdef_type_scheme) EQUAL e=located(expression) {
|
|
SimpleValue(i, ts, e)
|
|
}
|
|
/* Fonction(s)
|
|
* Exemple :
|
|
* - fun : int f a = 1
|
|
* - fun f a = 1 and : int g a = 2 */
|
|
| FUN fl=separated_nonempty_list(AND_KW, fundef) {
|
|
RecFunctions(fl)
|
|
}
|
|
|
|
vdef_type_scheme:
|
|
| COLON ts=located(type_scheme) {
|
|
ts
|
|
}
|
|
|
|
|
|
fundef:
|
|
| COLON t=option(located(type_scheme)) i=located(identifier) p=located(pattern) EQUAL e=located(expression) {
|
|
i, t, FunctionDefinition(p, e)
|
|
}
|
|
| i=located(identifier) p=located(pattern) EQUAL e=located(expression) {
|
|
i, None, FunctionDefinition(p, e)
|
|
}
|
|
|
|
|
|
/********************************** PATTERN ***********************************/
|
|
/* à revoir éventuellement : PTaggedValue (et PRecord) est réécrite 4 fois, mais
|
|
* peut être qu'en utilisant des option, on pourrait diminuer le nombre de répétition.
|
|
* TODO : y'a environ 50 warnings ici, surtout au niveau du POr et PAnd */
|
|
|
|
branches:
|
|
| b=separated_nonempty_list(PIPE, located(branch)) {
|
|
b
|
|
}
|
|
| PIPE b=separated_nonempty_list(PIPE, located(branch)) {
|
|
b
|
|
}
|
|
|
|
branch:
|
|
| p=located(pattern) ARROW e=located(expression) {
|
|
Branch(p, e)
|
|
}
|
|
|
|
|
|
simple_pattern:
|
|
/* Parenthésage */
|
|
| LPAREN p=pattern RPAREN {
|
|
p
|
|
}
|
|
/* Motif universel liant */
|
|
| i=located(identifier) {
|
|
PVariable i
|
|
}
|
|
/* Motif universel non liant */
|
|
| WILDCARD {
|
|
PWildcard
|
|
}
|
|
/* Annotation de type */
|
|
| p=located(simple_pattern) COLON ty=located(ty) {
|
|
PTypeAnnotation(p, ty)
|
|
}
|
|
/* Entier / Caractère / String */
|
|
| l=located(literal) {
|
|
PLiteral l
|
|
}
|
|
/* Valeurs étiquetées */
|
|
| const=located(constructor) {
|
|
PTaggedValue(const, None, [])
|
|
}
|
|
| const=located(constructor) INFERIOR liste_ty=option(separated_nonempty_list(COMMA, located(ty))) SUPERIOR {
|
|
PTaggedValue(const, liste_ty, [])
|
|
}
|
|
| const=located(constructor) LPAREN liste_pattern=separated_nonempty_list(COMMA, located(pattern)) RPAREN {
|
|
PTaggedValue(const, None, liste_pattern)
|
|
}
|
|
| const=located(constructor) INFERIOR liste_ty=option(separated_nonempty_list(COMMA, located(ty))) SUPERIOR LPAREN liste_pattern=separated_nonempty_list(COMMA, located(pattern)) RPAREN {
|
|
PTaggedValue(const, liste_ty, liste_pattern)
|
|
}
|
|
/* Enregistrement */
|
|
/* à refaire */
|
|
| LBRACE l=separated_nonempty_list(COMMA, separated_pair(located(label), EQUAL, located(pattern))) RBRACE {
|
|
PRecord(l, None)
|
|
}
|
|
| LBRACE l=separated_nonempty_list(COMMA, separated_pair(located(label), EQUAL, located(pattern))) RBRACE INFERIOR SUPERIOR {
|
|
PRecord(l, None)
|
|
}
|
|
| LBRACE l=separated_nonempty_list(COMMA, separated_pair(located(label), EQUAL, located(pattern))) RBRACE INFERIOR liste_ty=option(separated_nonempty_list(COMMA, located(ty))) SUPERIOR {
|
|
PRecord(l, liste_ty)
|
|
}
|
|
/* Disjonction */
|
|
|
|
pattern:
|
|
| p1=pattern_and {
|
|
p1
|
|
}
|
|
| p1=located(pattern_and) PIPE p_list=separated_nonempty_list(PIPE, located(pattern_and)) {
|
|
POr(p1 :: p_list)
|
|
}
|
|
/* Conjonction */
|
|
pattern_and:
|
|
| p1=simple_pattern{
|
|
p1
|
|
}
|
|
| p1=located(simple_pattern) AND p_list=separated_nonempty_list(AND, located(simple_pattern)) {
|
|
PAnd(p1 :: p_list)
|
|
}
|
|
|
|
pattern_list:
|
|
/* N-uplets */
|
|
| LPAREN p=separated_nonempty_list(COMMA, pattern) RPAREN {
|
|
p
|
|
}
|
|
|
|
|
|
/********************************* DATA TYPE **********************************/
|
|
/* Pour résoudre un conflit, on a du split ty en 2 règles
|
|
*
|
|
* separated_nonempty_list(STAR,located(ty)) -> ty STAR separated_nonempty_list(STAR,located(ty))
|
|
* [ ty ] -> ty * [ ty ]
|
|
* ET
|
|
* ty -> ty STAR separated_nonempty_list(STAR,located(ty))
|
|
* ty -> ty * [ ty ]
|
|
*/
|
|
simple_ty:
|
|
/* Application d'un constructeur de type */
|
|
| tc=type_constructor {
|
|
TyCon(tc, [])
|
|
}
|
|
| tc=type_constructor INFERIOR liste_ty=separated_nonempty_list(COMMA, located(ty)) SUPERIOR {
|
|
TyCon(tc, liste_ty)
|
|
}
|
|
/* Variables de type */
|
|
| type_var=type_variable {
|
|
TyVar(type_var)
|
|
}
|
|
/* Type entre parenthèses */
|
|
| LPAREN ty1=ty RPAREN {
|
|
ty1
|
|
}
|
|
|
|
|
|
ty:
|
|
/* Un type peut être un simple_type */
|
|
| t=simple_ty {
|
|
t
|
|
}
|
|
/* Fonctions */
|
|
| ty1=located(ty) ARROW ty2=located(ty) {
|
|
TyArrow(ty1, ty2)
|
|
}
|
|
/* N-uplets (N > 1) */
|
|
| th=located(simple_ty) STAR tt=separated_nonempty_list(STAR, located(simple_ty)) {
|
|
TyTuple(th :: tt)
|
|
}
|
|
|
|
|
|
type_scheme:
|
|
/* Il faut peut être modifié le séparateur */
|
|
| LBRACK liste_typevar=separated_list(COMMA, located(type_variable)) RBRACK ty=located(ty) {
|
|
ForallTy(liste_typevar, ty)
|
|
}
|
|
| ty=located(ty) {
|
|
ForallTy([], ty)
|
|
}
|
|
|
|
|
|
/********************************* EXPRESSION *********************************/
|
|
|
|
/* De manière générale, il faudrait au mieux revoir le code, pour le factoriser et le rendre plus propre */
|
|
/* (il y a même moyen que ça le soit obligatoire pour pas avoir des conflits éventuel) */
|
|
/* Exemple : TAgged et Record, trop de cas différent alors qu'on pourrait en faire en 2 fois au moins voir 1 */
|
|
simple_expression:
|
|
/* Simple litteral */
|
|
| l=located(literal) {
|
|
Literal l
|
|
}
|
|
/* Variable */
|
|
| i=located(identifier) {
|
|
Variable(i, None)
|
|
}
|
|
| i=located(identifier) INFERIOR SUPERIOR {
|
|
Variable(i, None)
|
|
}
|
|
| i=located(identifier) INFERIOR t_list=option(separated_nonempty_list(COMMA, located(ty))) SUPERIOR {
|
|
Variable(i, t_list)
|
|
}
|
|
|
|
/* Tuple n = 0 and n > 1 */
|
|
| LPAREN RPAREN {
|
|
Tuple([])
|
|
}
|
|
| LPAREN e=located(expression) COMMA e_list=separated_nonempty_list(COMMA, located(expression)) RPAREN {
|
|
Tuple(e::e_list)
|
|
}
|
|
|
|
/* Tagged Value*/
|
|
/* K */
|
|
| const=located(constructor) {
|
|
Tagged(const, None, [])
|
|
}
|
|
/* K < > */
|
|
| const=located(constructor) INFERIOR SUPERIOR {
|
|
Tagged(const, None, [])
|
|
}
|
|
/* K < > (e1, ..., en) */
|
|
| const=located(constructor) INFERIOR SUPERIOR LPAREN e_list=separated_nonempty_list(COMMA, located(expression)) RPAREN {
|
|
Tagged(const, None, e_list)
|
|
}
|
|
/* K <ty_1, ... ty_m> */
|
|
| const=located(constructor) INFERIOR t_list=option(separated_nonempty_list(COMMA, located(ty))) SUPERIOR {
|
|
Tagged(const, t_list, [])
|
|
}
|
|
/* K <ty_1, ..., ty_m> (e1,...,en) */
|
|
| const=located(constructor) INFERIOR t_list=option(separated_nonempty_list(COMMA, located(ty))) SUPERIOR LPAREN e_list=separated_nonempty_list(COMMA, located(expression)) RPAREN {
|
|
Tagged(const, t_list, e_list)
|
|
}
|
|
|
|
/* Record */
|
|
| LBRACE l=separated_nonempty_list(COMMA, separated_pair(located(label), EQUAL, located(expression))) RBRACE {
|
|
Record(l, None)
|
|
}
|
|
| LBRACE l=separated_nonempty_list(COMMA, separated_pair(located(label), EQUAL, located(expression))) RBRACE INFERIOR SUPERIOR {
|
|
Record(l, None)
|
|
}
|
|
| LBRACE l=separated_nonempty_list(COMMA, separated_pair(located(label), EQUAL, located(expression))) RBRACE INFERIOR t_list=option(separated_nonempty_list(COMMA, located(ty))) SUPERIOR {
|
|
Record(l, t_list)
|
|
}
|
|
|
|
/* Lecture de variable */
|
|
/* ! expr */
|
|
| EXCLA e=located(simple_expression) {
|
|
Read(e)
|
|
}
|
|
|
|
|
|
|
|
expression:
|
|
| e=simple_expression {
|
|
e
|
|
}
|
|
/* Field */
|
|
|
|
/* e.l */
|
|
| e=located(expression) DOT l=located(label) {
|
|
Field(e, l, None)
|
|
}
|
|
/* e.l < > */
|
|
| e=located(expression) DOT l=located(label) INFERIOR SUPERIOR {
|
|
Field(e, l, None)
|
|
}
|
|
/* e.l <ty_1...ty_n>*/
|
|
| e=located(expression) DOT l=located(label) INFERIOR t_list=option(separated_nonempty_list(COMMA, located(ty))) SUPERIOR {
|
|
Field(e, l, t_list)
|
|
}
|
|
/* Sequence */
|
|
/* Pas sûr, voir s'il ne fuat pas une troisième couche d'expression */
|
|
| e=located(simple_expression) SEMICOLON e_list=separated_nonempty_list(SEMICOLON, located(simple_expression)) {
|
|
Sequence(e::e_list)
|
|
}
|
|
|
|
/* Definition locale */
|
|
| vd=vdefinition SEMICOLON e=located(expression) {
|
|
Define(vd, e)
|
|
}
|
|
|
|
/* Fonction anonyme */
|
|
| BACKSLASH p=located(pattern) ARROW e=located(expression) {
|
|
Fun(FunctionDefinition(p, e))
|
|
}
|
|
|
|
/* Application */
|
|
| e1=located(expression) e2=located(expression) {
|
|
Apply(e1, e2)
|
|
}
|
|
|
|
/* TODO operation binaire mais j'ai pas très bien compris encore */
|
|
|
|
|
|
/* Match (exp) {| ...| ... | ...} */
|
|
| MATCH LPAREN e=located(expression) RPAREN LBRACE b=branches RBRACE {
|
|
Case(e, b)
|
|
}
|
|
|
|
/* TODO if ( exp ) then { expr } j'ai RIEN COMPRIS */
|
|
/*
|
|
| IF LPAREN e=located(expression) RPAREN
|
|
THEN LBRACE e2=located(expression) RBRACE{
|
|
IfThenElse(e,e2,None)
|
|
}
|
|
*/
|
|
/* if ( expr ) then { expr } else { expr } */
|
|
| IF LPAREN e=located(expression) RPAREN
|
|
THEN LBRACE e2=located(expression) RBRACE
|
|
ELSE LBRACE e3=located(expression) RBRACE {
|
|
IfThenElse(e, e2, e3)
|
|
}
|
|
|
|
/* Reference ref expr */
|
|
|
|
| REF e=located(expression) {
|
|
Ref(e)
|
|
}
|
|
|
|
/* Affectation */
|
|
/* expr := expr */
|
|
|
|
| e1=located(expression) ASSIGN e2=located(expression) {
|
|
Assign(e1, e2)
|
|
}
|
|
|
|
/* While */
|
|
/* while ( expr ) { expr } */
|
|
| WHILE LPAREN e=located(expression) RPAREN
|
|
LBRACE e2=located(expression) RBRACE {
|
|
While(e, e2)
|
|
}
|
|
|
|
/* Do while TODO */
|
|
/* do { expr } until ( expr ) */
|
|
|
|
/* boucle for */
|
|
/* for x in (e1 to e2) { expr } */
|
|
| FOR x=located(identifier)
|
|
FROM LPAREN e1=located(expression) RPAREN TO LPAREN e2=located(expression) RPAREN
|
|
LBRACE e3=located(expression) RBRACE {
|
|
For(x, e1, e2, e3)
|
|
}
|
|
|
|
/* Parenthésage pas sûr mais je vois pas sinon*/
|
|
| LPAREN e=expression RPAREN {
|
|
e
|
|
}
|
|
|
|
/* Annotation de type */
|
|
/* (e : ty) */
|
|
| LPAREN e=located(expression) COLON t=located(ty) RPAREN {
|
|
TypeAnnotation(e, t)
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/******************************** BASIC TYPES *********************************/
|
|
type_variable:
|
|
| tid=TID {
|
|
TId tid
|
|
}
|
|
|
|
|
|
type_constructor:
|
|
| tcon=CID {
|
|
TCon tcon
|
|
}
|
|
|
|
|
|
constructor:
|
|
| kid=CID {
|
|
KId kid
|
|
}
|
|
|
|
|
|
label:
|
|
| label=ID {
|
|
LId label
|
|
}
|
|
|
|
|
|
literal:
|
|
| i=INT {
|
|
LInt i
|
|
}
|
|
| c=CHAR {
|
|
LChar c
|
|
}
|
|
| s=STRING {
|
|
LString s
|
|
}
|
|
|
|
|
|
identifier:
|
|
| i=ID {
|
|
Id i
|
|
}
|
|
|
|
|
|
%inline located(X): x=X {
|
|
Position.with_poss $startpos $endpos x
|
|
}
|