484 lines
11 KiB
OCaml
484 lines
11 KiB
OCaml
%{ (* -*- tuareg -*- *)
|
|
|
|
open HopixAST
|
|
|
|
%}
|
|
|
|
%token EOF LET TYPE WILDCARD ARROW COLON EXTERN FUN COMMA AND EQUAL LPAREN
|
|
%token RPAREN LBRACK RBRACK LBRACE RBRACE INFERIOR SUPERIOR DO ELSE FOR
|
|
%token FROM IF MATCH PIPE REF THEN TO UNTIL WHILE AND_KW DOT SEMICOLON BACKSLASH
|
|
%token ASSIGN EXCLA
|
|
%token PLUS MINUS STAR SLASH D_AND D_OR EQUAL_OP INF_EQUAL_OP SUP_EQUAL_OP INF_OP SUP_OP
|
|
|
|
%token<Mint.t> INT
|
|
%token<string> ID TID CID STRING
|
|
%token<char> CHAR
|
|
|
|
|
|
%start<HopixAST.t> program
|
|
|
|
%left LPAREN
|
|
|
|
%left STRING
|
|
%left INT CID CHAR
|
|
%left ID
|
|
%right ARROW
|
|
%right SEMICOLON
|
|
%left ASSIGN
|
|
%left LBRACE
|
|
|
|
%left EXCLA COLON
|
|
|
|
/* Priorités binop */
|
|
%left D_OR
|
|
%left D_AND
|
|
%left EQUAL_OP INF_EQUAL_OP INF_OP SUP_EQUAL_OP SUP_OP
|
|
%left PLUS MINUS
|
|
%left SLASH STAR
|
|
|
|
%left local_def1
|
|
%left fun1
|
|
%left app1
|
|
|
|
|
|
%%
|
|
|
|
|
|
/********************************** 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 */
|
|
| TYPE tc=located(type_constructor) tvl=optionlist(definition_typevariablelist)
|
|
EQUAL td=tdefinition {
|
|
DefineType (tc, tvl, td)
|
|
}
|
|
// La tdefinition peut être optionnel, dans ce cas on utilise c'est abstrait
|
|
| TYPE tc=located(type_constructor) tvl=optionlist(definition_typevariablelist) {
|
|
DefineType (tc, tvl, Abstract)
|
|
}
|
|
/* Valeurs externes */
|
|
| EXTERN id=located(var_identifier) COLON ts=located(type_scheme) {
|
|
DeclareExtern(id, ts)
|
|
}
|
|
/* Définition de valeurs */
|
|
| v=vdefinition {
|
|
DefineValue v
|
|
}
|
|
|
|
definition_typevariablelist:
|
|
| INFERIOR l=separated_nonempty_list(COMMA, located(type_variable)) SUPERIOR {
|
|
l
|
|
}
|
|
|
|
|
|
tdefinition:
|
|
/* Type sommes */
|
|
/* la définition étant assez compliqué,
|
|
* on va utilisé d'autre terme pour réduire la taille */
|
|
| option(PIPE)
|
|
l=separated_nonempty_list(PIPE, list_constructor_and_their_ty) {
|
|
DefineSumType(l)
|
|
}
|
|
/* Type produit étiqueté */
|
|
| LBRACE lt=separated_nonempty_list(COMMA, label_with_type) RBRACE {
|
|
DefineRecordType(lt)
|
|
}
|
|
|
|
list_constructor_and_their_ty:
|
|
| c=located(constructor) t=optionlist(list_ty) {
|
|
(c, t)
|
|
}
|
|
|
|
list_ty:
|
|
| LPAREN l=separated_nonempty_list(COMMA, located(ty)) RPAREN {
|
|
l
|
|
}
|
|
|
|
label_with_type:
|
|
| l=located(label_identifier) COLON t=located(ty) {
|
|
l, t
|
|
}
|
|
|
|
/* vdefinition et vdefinition_local font sensiblement la même chose,
|
|
* seulement l'ordre de priorité est différent */
|
|
vdefinition:
|
|
/* Valeur simple */
|
|
| LET i=located(var_identifier) ts=option(colon_type_scheme)
|
|
EQUAL e=located(expression) {
|
|
SimpleValue(i, ts, e)
|
|
}
|
|
/* Fonction(s) */
|
|
| FUN fl=separated_nonempty_list(AND_KW, fundef) {
|
|
RecFunctions(fl)
|
|
}
|
|
|
|
vdefinition_local:
|
|
/* Valeur simple */
|
|
| LET i=located(var_identifier) ts=option(colon_type_scheme)
|
|
EQUAL e=located(expression) %prec local_def1 {
|
|
SimpleValue(i, ts, e)
|
|
}
|
|
/* Fonction(s) */
|
|
| FUN fl=separated_nonempty_list(AND_KW, fundef) {
|
|
RecFunctions(fl)
|
|
}
|
|
|
|
|
|
fundef:
|
|
| t=option(colon_type_scheme) i=located(var_identifier) p=located(pattern)
|
|
EQUAL e=located(expression) %prec fun1 {
|
|
i, t, FunctionDefinition(p, e)
|
|
}
|
|
|
|
|
|
/********************************** PATTERN ***********************************/
|
|
branches:
|
|
| option(PIPE) b=separated_nonempty_list(PIPE, located(branch)) {
|
|
b
|
|
}
|
|
|
|
branch:
|
|
| p=located(pattern) ARROW e=located(expression) {
|
|
Branch(p, e)
|
|
}
|
|
|
|
|
|
simple_pattern:
|
|
/* Motif universel liant */
|
|
| i=located(var_identifier) {
|
|
PVariable i
|
|
}
|
|
/* Motif universel non liant */
|
|
| WILDCARD {
|
|
PWildcard
|
|
}
|
|
/* Parenthésage */
|
|
| LPAREN RPAREN {
|
|
PTuple([])
|
|
}
|
|
/* N-uplets */
|
|
| l=pattern_list {
|
|
match l with | [alone] -> Position.value alone | _ -> PTuple(l)
|
|
}
|
|
/* 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) tl=option(type_list) pl=optionlist(pattern_list) {
|
|
PTaggedValue(const, tl, pl)
|
|
}
|
|
/* Enregistrement */
|
|
| LBRACE l=separated_nonempty_list(
|
|
COMMA,
|
|
separated_pair(located(label_identifier), EQUAL, located(pattern))
|
|
) RBRACE tl=option(type_list) {
|
|
PRecord(l, tl)
|
|
}
|
|
|
|
pattern:
|
|
| p1=simple_pattern {
|
|
p1
|
|
}
|
|
/* Disjonction */
|
|
| p1=located(simple_pattern)
|
|
PIPE p_list=separated_nonempty_list(PIPE, located(simple_pattern)) {
|
|
POr(p1 :: p_list)
|
|
}
|
|
/* Conjonction */
|
|
| p1=located(simple_pattern)
|
|
AND p_list=separated_nonempty_list(AND, located(simple_pattern)) {
|
|
PAnd(p1 :: p_list)
|
|
}
|
|
|
|
pattern_list:
|
|
| LPAREN el=separated_nonempty_list(COMMA, located(pattern)) RPAREN {
|
|
el
|
|
}
|
|
|
|
|
|
/********************************* 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, [])
|
|
}
|
|
/* 'liste_ty' doit etre optionnel => gérer par le cas au dessus */
|
|
| 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:
|
|
| LBRACK liste_typevar=separated_list(COMMA, located(type_variable))
|
|
RBRACK ty=located(ty) {
|
|
ForallTy(liste_typevar, ty)
|
|
}
|
|
| ty=located(ty) {
|
|
ForallTy([], ty)
|
|
}
|
|
|
|
colon_type_scheme:
|
|
| COLON ts=located(type_scheme) {
|
|
ts
|
|
}
|
|
|
|
|
|
/********************************* EXPRESSION *********************************/
|
|
simple_expression:
|
|
/* Simple litteral */
|
|
| l=located(literal) {
|
|
Literal l
|
|
}
|
|
/* Variable */
|
|
| i=located(var_identifier) tl=option(type_list) {
|
|
Variable(i, tl)
|
|
}
|
|
/* Tuple n > 1 - Construction d'un n-uplet (n > 1) */
|
|
| el=expr_list {
|
|
(* S'il y a qu'1 élément, alors c'est juste une expression *)
|
|
match el with | [alone] -> Position.value alone | _ -> Tuple(el)
|
|
}
|
|
|
|
mid_expression:
|
|
| e=simple_expression {
|
|
e
|
|
}
|
|
/* Tagged Value - Construction d'une donnée
|
|
* TODO: Conflict shift/reduce sur le expr_list */
|
|
| const=located(constructor) tl=option(type_list) el=optionlist(expr_list) {
|
|
Tagged(const, tl, el)
|
|
}
|
|
/* Application */
|
|
| e1=located(mid_expression) e2=located(mid_expression) %prec app1 {
|
|
Apply(e1, e2)
|
|
}
|
|
/* Lecture de variable
|
|
* !expr */
|
|
| EXCLA e=located(simple_expression) {
|
|
Read(e)
|
|
}
|
|
/* Record - Construction d'un enregistrement */
|
|
| LBRACE l=separated_nonempty_list(
|
|
COMMA,
|
|
separated_pair(located(label_identifier), EQUAL, located(expression))
|
|
) RBRACE tl=option(type_list) {
|
|
Record(l, tl)
|
|
}
|
|
|
|
expression:
|
|
| e=mid_expression {
|
|
e
|
|
}
|
|
/* Annotation de type
|
|
* ( expr : type ) */
|
|
| LPAREN e=located(expression) COLON t=located(ty) RPAREN {
|
|
TypeAnnotation(e, t)
|
|
}
|
|
/* Tuple n = 0 - Construction d'un 0-uplet */
|
|
| LPAREN RPAREN {
|
|
Tuple([])
|
|
}
|
|
/* Sequence - Séquencement */
|
|
| e=located(expression) SEMICOLON e2=located(expression) {
|
|
Sequence([e; e2])
|
|
}
|
|
/* Definition locale */
|
|
| vd=vdefinition_local SEMICOLON e=located(expression) {
|
|
Define(vd, e)
|
|
}
|
|
/* Fonction anonyme */
|
|
| BACKSLASH p=located(pattern) ARROW e=located(expression) {
|
|
Fun(FunctionDefinition(p, e))
|
|
}
|
|
/* Operateurs binaires - Application infixe */
|
|
| e1=located(expression) b=binop e2=located(expression) {
|
|
Apply(
|
|
Position.unknown_pos (Apply(
|
|
Position.unknown_pos (
|
|
Variable (
|
|
Position.unknown_pos (Id b),
|
|
None
|
|
)
|
|
),
|
|
e1
|
|
)),
|
|
e2
|
|
)
|
|
}
|
|
/* Analyse de motifs
|
|
* match (exp) {| ...| ... | ...} */
|
|
| MATCH LPAREN e=located(expression) RPAREN LBRACE b=branches RBRACE {
|
|
Case(e, b)
|
|
}
|
|
/* Conditionnelle (1)
|
|
* if ( expr ) then { expr } */
|
|
| IF LPAREN e1=located(expression) RPAREN
|
|
THEN LBRACE e2=located(expression) RBRACE {
|
|
(* else { () } aka le 0-uplet *)
|
|
IfThenElse(e1, e2, Position.unknown_pos (Tuple []))
|
|
}
|
|
/* Conditionnelle (2)
|
|
* if ( expr ) then { expr } else { expr } */
|
|
| IF LPAREN e1=located(expression) RPAREN
|
|
THEN LBRACE e2=located(expression) RBRACE
|
|
ELSE LBRACE e3=located(expression) RBRACE {
|
|
IfThenElse(e1, e2, e3)
|
|
}
|
|
/* Affectation
|
|
* expr := expr */
|
|
| e1=located(expression) ASSIGN e2=located(expression) {
|
|
Assign(e1, e2)
|
|
}
|
|
/* While - Boucle non bornée
|
|
* while ( expr ) { expr } */
|
|
| WHILE LPAREN e1=located(expression) RPAREN
|
|
LBRACE e2=located(expression) RBRACE {
|
|
While(e1, e2)
|
|
}
|
|
/* Do while - Boucle non bornée et non vide
|
|
* do { expr } until ( expr ) */
|
|
| DO LBRACE e1=located(expression) RBRACE
|
|
UNTIL LPAREN e2=located(expression) RPAREN {
|
|
Sequence([e1 ; Position.unknown_pos (While(e2, e1))])
|
|
}
|
|
/* Boucle for - Boucle bornée
|
|
* for x in (e1 to e2) { expr } */
|
|
| FOR var=located(var_identifier)
|
|
FROM LPAREN e1=located(expression) RPAREN
|
|
TO LPAREN e2=located(expression) RPAREN
|
|
LBRACE e3=located(expression) RBRACE {
|
|
For(var, e1, e2, e3)
|
|
}
|
|
/* Allocation
|
|
* ref expr */
|
|
| REF e=located(mid_expression) {
|
|
Ref(e)
|
|
}
|
|
/* Field record */
|
|
| e=located(mid_expression) DOT l=located(label_identifier) tl=option(type_list) {
|
|
Field(e, l, tl)
|
|
}
|
|
|
|
type_list:
|
|
| INFERIOR tl=separated_list(COMMA, located(ty)) SUPERIOR {
|
|
tl
|
|
}
|
|
|
|
expr_list:
|
|
| LPAREN el=separated_nonempty_list(COMMA, located(expression)) RPAREN {
|
|
el
|
|
}
|
|
|
|
|
|
/******************************** BASIC TYPES *********************************/
|
|
var_identifier:
|
|
| var_id=ID {
|
|
Id var_id
|
|
}
|
|
|
|
type_variable:
|
|
| tid=TID {
|
|
TId tid
|
|
}
|
|
|
|
constructor:
|
|
| constr_id=CID {
|
|
KId constr_id
|
|
}
|
|
|
|
type_constructor:
|
|
| type_con=ID {
|
|
TCon type_con
|
|
}
|
|
|
|
label_identifier:
|
|
| label=ID {
|
|
LId label
|
|
}
|
|
|
|
literal:
|
|
/* Entier positif */
|
|
| i=INT {
|
|
LInt i
|
|
}
|
|
/* Caractère */
|
|
| c=CHAR {
|
|
LChar c
|
|
}
|
|
/* Chaîne de caractères */
|
|
| s=STRING {
|
|
LString s
|
|
}
|
|
|
|
|
|
/****************************** INLINE FUNCTIONS ******************************/
|
|
%inline binop:
|
|
| PLUS { "`+`" }
|
|
| MINUS { "`-`" }
|
|
| STAR { "`*`" }
|
|
| SLASH { "`/`" }
|
|
| D_AND { "`&&`" }
|
|
| D_OR { "`||`" }
|
|
| EQUAL_OP { "`=?`" }
|
|
| INF_EQUAL_OP { "`<=?`" }
|
|
| SUP_EQUAL_OP { "`>=?`" }
|
|
| INF_OP { "`<?`" }
|
|
| SUP_OP { "`>?`" }
|
|
|
|
%inline located(X): x=X {
|
|
Position.with_poss $startpos $endpos x
|
|
}
|
|
|
|
%inline optionlist(X): x=option(X) {
|
|
match x with | Some l -> l | None -> []
|
|
}
|