This repository has been archived on 2024-01-18. You can view files and clone it, but cannot push or open issues or pull requests.
compilation/flap/src/hopix/hopixParser.mly
2023-10-24 14:42:23 +02:00

527 lines
12 KiB
OCaml
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

%{ (* -*- 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
/* TODO: Résoudre tout les shift/reduce conflits */
%left LPAREN
%left let1
%left FUN
%left STRING
%left INT CID CHAR WHILE
%left ID
%right REF DO
%left LET MATCH IF FOR
%right ARROW
%right SEMICOLON
%left DOT
%left ASSIGN
%left LBRACE
%left BACKSLASH
%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 fun1
%%
/********************************** 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(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:
// TODO: C'est pas sensé être en option list_ty ici?
| c=located(constructor) t=list_ty {
(c, t)
}
list_ty:
| LPAREN l=separated_nonempty_list(COMMA, located(ty)) RPAREN {
l
}
label_with_type:
| l=located(label) COLON t=located(ty) {
l, t
}
vdefinition:
/* Valeur simple */
| LET i=located(identifier) ts=option(colon_type_scheme)
EQUAL e=located(expression) %prec let1 {
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)
}
fundef:
| t=option(colon_type_scheme) i=located(identifier) p=located(pattern)
EQUAL e=located(expression) %prec fun1 {
i, t, 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:
| 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(identifier) {
PVariable i
}
/* Motif universel non liant */
| WILDCARD {
PWildcard
}
/* N-uplets ou parenthésage */
| LPAREN p=optionlist(separated_nonempty_list(COMMA, located(pattern))) RPAREN {
PTuple(p)
}
/* 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), 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(identifier) tl=option(type_list) {
Variable(i, tl)
}
/* Tagged Value - Construction d'une donnée */
| const=located(constructor) tl=option(type_list) el=optionlist(expr_list) {
Tagged(const, tl, el)
}
/* Tuple n = 0 - Construction d'un 0-uplet */
| LPAREN RPAREN {
Tuple([])
}
/* 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)
}
/* Record - Construction d'un enregistrement */
| LBRACE l=separated_nonempty_list(
COMMA,
separated_pair(located(label), EQUAL, located(expression))
) RBRACE tl=option(type_list) {
Record(l, tl)
}
/* Lecture de variable
* !expr */
| EXCLA e=located(simple_expression) {
Read(e)
}
type_list:
| INFERIOR tl=separated_list(COMMA, located(ty)) SUPERIOR {
tl
}
expr_list:
| LPAREN el=separated_nonempty_list(COMMA, located(expression)) RPAREN {
el
}
expression:
| e=simple_expression {
e
}
/* Field - Projection dun champ */
| e=located(expression) DOT l=located(label) tl=option(type_list) {
Field(e, l, tl)
}
/* Sequence - Séquencement *
* Pas sûr, voir s'il ne faut 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)
}
/* | e1=located(expression) SEMICOLON e2=located(expression) {
Sequence([e1; e2])
} */
/* 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)
}
/* 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
)
}
// Je met en commentaire parce que donner la location passe pas
// plus de tests et ça rajoute plein de trucs relou donc jsp
/* | e1=located(expression) b=var_binop(binop) e2=located(expression) {
Apply(
Position.with_pos (
(Position.position b))
(Apply(b, 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)
}
/* Reference - Allocation
* ref expr */
| REF e=located(simple_expression) {
Ref(e)
}
/* 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(identifier)
FROM LPAREN e1=located(expression) RPAREN
TO LPAREN e2=located(expression) RPAREN
LBRACE e3=located(expression) RBRACE {
For(var, 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:
/* Entier positif */
| i=INT {
LInt i
}
/* Caractère */
| c=CHAR {
LChar c
}
/* Chaîne de caractères */
| s=STRING {
LString s
}
identifier:
| i=ID {
Id i
}
%inline binop:
| PLUS { "`+`" }
| MINUS { "`-`" }
| STAR { "`*`" }
| SLASH { "`/`" }
| D_AND { "`&&`" }
| D_OR { "`||`" }
| EQUAL_OP { "`=?`" }
| INF_EQUAL_OP { "`<=?`" }
| SUP_EQUAL_OP { "`>=?`" }
| INF_OP { "`<?`" }
| SUP_OP { "`>?`" }
// Utile pour le binop avec location :
// %inline binop:
// | loc=location(PLUS) { ("`+`", loc) }
// | loc=location(MINUS) { ("`-`", loc) }
// | loc=location(STAR) { ("`*`", loc) }
// | loc=location(SLASH) { ("`/`", loc) }
// | loc=location(D_AND) { ("`&&`", loc) }
// | loc=location(D_OR) { ("`||`", loc) }
// | loc=location(EQUAL_OP) { ("`=?`", loc) }
// | loc=location(INF_EQUAL_OP) { ("`<=?`", loc) }
// | loc=location(SUP_EQUAL_OP) { ("`>=?`", loc) }
// | loc=location(INF_OP) { ("`<?`", loc) }
// | loc=location(SUP_OP) { ("`>?`", loc) }
// /* On récupère juste la position de X */
// %inline location(X): X {
// Position.position (Position.with_poss $startpos $endpos None)
// }
// /* On transforme notre binop en variable located */
// %inline var_binop(X): x=X {
// Position.with_pos
// (snd x)
// (Variable (Position.with_pos (snd x) (Id (fst x)), None))
// }
%inline located(X): x=X {
Position.with_poss $startpos $endpos x
}
%inline optionlist(X): x=option(X) {
match x with | Some l -> l | None -> []
}