-
Notifications
You must be signed in to change notification settings - Fork 0
/
parser.mly
192 lines (154 loc) · 5.7 KB
/
parser.mly
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
%{
open Exprs
let full_span() = (Parsing.symbol_start_pos (), Parsing.symbol_end_pos ())
let tok_span(start, endtok) = (Parsing.rhs_start_pos start, Parsing.rhs_end_pos endtok)
%}
%token <int64> NUM
%token <string> ID
%token DEF ANDDEF ADD1 SUB1 LPARENSPACE LPARENNOSPACE RPAREN LBRACK RBRACK LET IN EQUAL COMMA PLUS MINUS TIMES IF COLON ELSECOLON EOF PRINTSTACK TRUE FALSE ISBOOL ISNUM ISTUPLE EQEQ LESSSPACE GREATER LESSEQ GREATEREQ AND OR NOT COLONEQ SEMI NIL LAMBDA BEGIN END SHADOW REC UNDERSCORE NEW STRUCT DOT IS ENDSTRUCT METHOD AS
%right SEMI
%left COLON COLONEQ
%left PLUS MINUS TIMES GREATER LESSSPACE GREATEREQ LESSEQ EQEQ AND OR
%left LPARENNOSPACE
%type <(Lexing.position * Lexing.position) Exprs.program> program
%start program
%%
const :
| NUM { ENumber($1, full_span()) }
| TRUE { EBool(true, full_span()) }
| FALSE { EBool(false, full_span()) }
| NIL %prec SEMI { ENil(full_span()) }
prim1 :
| ADD1 { Add1 }
| SUB1 { Sub1 }
| NOT { Not }
| ISBOOL { IsBool }
| ISNUM { IsNum }
| ISTUPLE { IsTuple }
| PRINTSTACK { PrintStack }
bindings :
| bind EQUAL expr { [($1, $3, full_span())] }
| bind EQUAL expr COMMA bindings { ($1, $3, tok_span(1, 3))::$5 }
namebindings :
| namebind EQUAL expr { [($1, $3, full_span())] }
| namebind EQUAL expr COMMA namebindings { ($1, $3, tok_span(1, 3))::$5 }
expr :
| LET bindings IN expr { ELet($2, $4, full_span()) }
| LET REC namebindings IN expr { ELetRec($3, $5, full_span()) }
| IF expr COLON expr ELSECOLON expr { EIf($2, $4, $6, full_span()) }
| BEGIN expr END { $2 }
| binop_expr SEMI expr { ESeq($1, $3, full_span()) }
| binop_expr { $1 }
exprs :
| expr { [$1] }
| expr COMMA exprs { $1::$3 }
tuple_expr :
| LPARENNOSPACE RPAREN { ETuple([], full_span()) }
| LPARENSPACE RPAREN { ETuple([], full_span()) }
| LPARENNOSPACE expr COMMA RPAREN { ETuple([$2], full_span()) }
| LPARENSPACE expr COMMA RPAREN { ETuple([$2], full_span()) }
| LPARENNOSPACE expr COMMA exprs RPAREN { ETuple($2::$4, full_span()) }
| LPARENSPACE expr COMMA exprs RPAREN { ETuple($2::$4, full_span()) }
id :
| ID %prec COLON { EId($1, full_span()) }
prim2 :
| PLUS { Plus }
| MINUS { Minus }
| TIMES { Times }
| AND { And }
| OR { Or }
| GREATER { Greater }
| GREATEREQ { GreaterEq }
| LESSSPACE { Less }
| LESSEQ { LessEq }
| EQEQ { Eq }
binop_expr :
| binop_expr prim2 binop_operand %prec PLUS { EPrim2($2, $1, $3, full_span()) }
| binop_operand COLONEQ binop_expr %prec COLONEQ {
match $1 with
| EGetter (stru, field, _) -> ESetter(stru, field, $3, full_span())
| EGetItem(lhs, idx, _) -> ESetItem(lhs, idx, $3, full_span())
| _ -> raise Parsing.Parse_error
}
| binop_operand %prec PLUS { $1 }
binop_operand :
// Primops
| prim1 LPARENNOSPACE expr RPAREN { EPrim1($1, $3, full_span()) }
// Tuples
| tuple_expr { $1 }
| binop_operand LBRACK expr RBRACK { EGetItem($1, $3, full_span()) }
// Function calls
| binop_operand LPARENNOSPACE exprs RPAREN %prec LPARENNOSPACE { EApp($1, $3, Unknown, full_span()) }
| binop_operand LPARENNOSPACE RPAREN %prec LPARENNOSPACE { EApp($1, [], Unknown, full_span()) }
// Parentheses
| LPARENSPACE expr RPAREN { $2 }
| LPARENNOSPACE expr RPAREN { $2 }
// Lambdas
| LPARENNOSPACE LAMBDA LPARENNOSPACE binds RPAREN COLON expr RPAREN { ELambda($4, $7, full_span()) }
| LPARENNOSPACE LAMBDA LPARENSPACE binds RPAREN COLON expr RPAREN { ELambda($4, $7, full_span()) }
| LPARENNOSPACE LAMBDA COLON expr RPAREN { ELambda([], $4, full_span()) }
| LPARENSPACE LAMBDA LPARENNOSPACE binds RPAREN COLON expr RPAREN { ELambda($4, $7, full_span()) }
| LPARENSPACE LAMBDA LPARENSPACE binds RPAREN COLON expr RPAREN { ELambda($4, $7, full_span()) }
| LPARENSPACE LAMBDA COLON expr RPAREN { ELambda([], $4, full_span()) }
// Structs
| NEW ID LPARENNOSPACE exprs RPAREN %prec LPARENNOSPACE { EConstruct($2, $4, full_span()) }
| NEW ID LPARENNOSPACE RPAREN %prec LPARENNOSPACE { EConstruct($2, [], full_span()) }
| binop_operand DOT ID { EGetter($1, $3, full_span()) }
| binop_operand IS ID { EIs ($1, $3, full_span()) }
| binop_operand AS ID { EAs ($1, $3, full_span()) }
// Simple cases
| const { $1 }
| id { $1 }
decl :
| DEF ID LPARENNOSPACE RPAREN COLON expr { DFun($2, [], $6, full_span()) }
| DEF ID LPARENNOSPACE binds RPAREN COLON expr { DFun($2, $4, $7, full_span()) }
binds :
| bind { [$1] }
| bind COMMA binds { $1::$3 }
bind :
| namebind { $1 }
| strubind { $1 }
| blankbind { $1 }
| LPARENNOSPACE binds RPAREN { BTuple($2, full_span()) }
| LPARENSPACE binds RPAREN { BTuple($2, full_span()) }
blankbind :
| UNDERSCORE %prec SEMI { BBlank(full_span()) }
namebind :
| ID %prec SEMI { BName($1, false, full_span()) }
| SHADOW ID %prec SEMI { BName($2, true, full_span()) }
strubind:
| ID COLON ID { BStruct($1, $3, full_span()) }
declgroup :
| decl { [$1] }
| decl ANDDEF declgroup { $1::$3 }
decls :
| { [] }
| declgroup decls { $1::$2 }
strufield :
| ID { FName($1) }
| ID COLON ID { FStruct($1, $3) }
strufields :
| strufield { [$1] }
| strufield COMMA strufields { $1::$3 }
strufieldgroup :
| LPARENNOSPACE RPAREN { [] }
| LPARENSPACE RPAREN { [] }
| LPARENNOSPACE strufields RPAREN { $2 }
| LPARENSPACE strufields RPAREN { $2 }
mthd :
| METHOD ID LPARENNOSPACE RPAREN COLON expr { DMethod($2, [], $6, full_span()) }
| METHOD ID LPARENNOSPACE binds RPAREN COLON expr { DMethod($2, $4, $7, full_span()) }
mthds :
| { [] }
| mthd mthds { $1::$2 }
mthdsgroup :
| { [] }
| mthds ENDSTRUCT { $1 }
stru :
| STRUCT ID EQUAL strufieldgroup IN mthdsgroup { DStruct ($2, $4, $6, full_span()) }
strus :
| { [] }
| stru strus { $1::$2 }
program :
| strus decls expr EOF { Program($1, $2, $3, full_span()) }
%%