summaryrefslogtreecommitdiff
path: root/parser.mly
blob: f084336c5125f91f7bd5d546f480cec5c488dc84 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
/* Analyseur syntaxique pour Petit Caml */

%{
open Ast
open Utils
%}

%token <int> INTEGER
%token <string> STRING
%token TRUE FALSE
%token UNIT
%token <string> IDENT
%token ELSE FUNCTION IF IN LET MATCH NOT REC THEN WITH
%token EMPTYLIST RIGHTARROW TWOCOLONS CASE UNDERSCORE
%token PLUS MINUS TIMES DIV AND OR
%token LE GE LT GT NEQ EQ
%token LBRACE RBRACE LPAREN RPAREN COMMA SEMICOLON
%token EOF

/* Définitions des priorités et associativités des tokens */

%nonassoc IN
%nonassoc ELSE
%nonassoc RIGHTARROW
%left AND OR
%left LT LE GT GE EQ NEQ
%right TWOCOLONS
%left MINUS PLUS
%left TIMES DIV
%nonassoc UMINUS NOT

/* Point d'entrée de la grammaire */
%start fichier

/* Type des valeurs retournées par l'analyseur syntaxique */
%type <Ast.expr> fichier

%%

fichier:
  decls = list(decl) EOF
  {
    let rec reduce_decls = function
        | [] -> raw_expr (Econst Cunit)
        | (m, e, loc)::l -> locd_expr (Eletin (m, e, (reduce_decls l))) loc
    in
        reduce_decls decls
  }

const:
| a = INTEGER { Cint a }
| s = STRING  { Cstring s }
| TRUE        { Cbool true }
| FALSE       { Cbool false }
| UNIT        { Cunit }
| EMPTYLIST   { Cemptylist } 
;

motif:
| UNDERSCORE { locd_motif Munderscore (make_loc $startpos $endpos) }
| id = IDENT { locd_motif (Mident id) (make_loc $startpos $endpos) }
| LPAREN m = motif COMMA motifs = separated_nonempty_list(COMMA, motif) RPAREN
  { locd_motif (Mtuple (m::motifs)) (make_loc $startpos $endpos) }
;

decl:
| LET name = motif EQ e = expr
  { (name, e, make_loc $startpos $endpos) }
| LET recur = ioption(REC) id = IDENT args = nonempty_list(motif) EQ e = expr
  { (locd_motif (Mident id) (make_loc $startpos(id) $endpos(id)),
     { e = (make_func id recur e args) ; t = None ; loc = e.loc },
     make_loc $startpos $endpos) }
;

simple_expr:
| LPAREN e = expr RPAREN { e }
| id = IDENT             { locd_expr (Eident id) (make_loc $startpos $endpos) }
| c = const              { locd_expr (Econst c) (make_loc $startpos $endpos) }
| LPAREN e = expr COMMA exprs = separated_nonempty_list(COMMA, expr) RPAREN
  { locd_expr (Etuple (e::exprs)) (make_loc $startpos $endpos) }
| LBRACE exprs = separated_list(SEMICOLON, expr) RBRACE
  { List.fold_right (fun expr base ->
                        { e = (Elistcons (expr, base)) ;
                          t = None ;
                          loc = (make_start_end_loc expr.loc base.loc) })
                    exprs
                    (locd_expr (Econst (Cemptylist))
                               (make_loc $startpos $endpos)) }
;

expr:
| e = simple_expr { e }
| func = simple_expr args = nonempty_list(simple_expr)
  { match args with
        | [] -> failwith "parser.mly / expr : Unreachable matching"
        | arg::args ->
            List.fold_left (fun base arg ->
                            { e = (Ecall (base, arg)) ;
                              t = None ;
                              loc = arg.loc })
                            { e = (Ecall (func, arg)) ;
                              t = None ;
                              loc = (make_start_end_loc func.loc arg.loc) }
                           args }
| FUNCTION m = motif RIGHTARROW e = expr
  { locd_expr (Efunc ({ name = raw_motif (Munderscore) ;
                        recursive = false ;
                        arg = m ;
                        body = e }))
              (make_loc $startpos $endpos) }
| e = unopexpr { locd_expr e (make_loc $startpos $endpos) }
| left = expr o = binop right = expr
  { locd_expr (Ebinop (left, o, right))
              (make_loc $startpos $endpos) }
| head = expr TWOCOLONS tail = expr
  { locd_expr (Elistcons (head, tail))
              (make_loc $startpos $endpos) }
| IF cond = expr THEN then_expr = expr ELSE else_expr = expr
  { locd_expr (Eif (cond, then_expr, else_expr))
              (make_loc $startpos $endpos) }
| LET m = motif EQ value = expr IN body = expr
  { locd_expr (Eletin (m, value, body))
              (make_loc $startpos $endpos) }
| LET recur = ioption(REC) id = IDENT args = nonempty_list(motif)
  EQ fbody = expr IN body = expr
  { locd_expr (Eletin (locd_motif (Mident id) (make_loc $startpos(id)
                                                        $endpos(id)),
                       { e = (make_func id recur fbody args) ;
                         t = None ;
                         loc = fbody.loc },
                       body))
              (make_loc $startpos $endpos) }
| MATCH e = expr WITH
  EMPTYLIST RIGHTARROW empty_e = expr
  CASE head = motif TWOCOLONS tail = motif RIGHTARROW match_expr = expr
  { locd_expr (Ematch (e, empty_e, head, tail, match_expr))
              (make_loc $startpos $endpos) }
;

unopexpr:
| MINUS e = expr %prec UMINUS { Eunop (ONeg, e) }
| NOT e = expr { Eunop (ONot, e) }
;

%inline binop:
| PLUS  { OAdd }
| MINUS { OSub }
| TIMES { OMul }
| DIV   { ODiv }
| AND   { OAnd }
| OR    { OOr }
| EQ    { OEq }
| NEQ   { ONeq }
| LT    { OLt }
| LE    { OLe }
| GT    { OGt }
| GE    { OGe }
;