miniMLparser.opp.exp 8.38 KB
Newer Older
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
File "miniMLparser.mly", line 55, characters 7-13:
Warning: the token LIDENT is unused.
%{

open Modules
open MiniML
open MLTyping

let variables = ref ([] : (string * ML.type_variable) list)

let reset_type_variables () =
  variables := []

let find_type_variable name =
  try
    List.assoc name !variables
  with Not_found ->
    let v = newvar() in
    variables := (name, v) :: !variables;
    v

let binop op arg1 arg2 =
  ML.Apply(ML.Apply(ML.Longident(Pident(Ident.create op)), arg1), arg2)
let ternop op arg1 arg2 arg3 =
  ML.Apply(ML.Apply(ML.Apply(ML.Longident(Pident(Ident.create op)), arg1), arg2), arg3)

%}
%start implementation
%start phrase
%token ARROW
31
%token COLON
32
%token COMMA
33 34 35 36 37 38 39 40
%token DOT
%token ELSE
%token END
%token EOF
%token EQUAL
%token EQUALEQUAL
%token FUNCTION
%token FUNCTOR
41
%token GREATER
42 43 44 45 46 47 48 49 50 51 52
%token GREATEREQUAL
%token <string> IDENT
%token IF
%token IN
%token <int> INT
%token LESS
%token LESSEQUAL
%token LESSGREATER
%token LET
%token LIDENT
%token LPAREN
53
%token MINUS
54 55 56 57 58 59 60
%token MODULE
%token PLUS
%token QUOTE
%token RPAREN
%token SEMICOLON
%token SEMISEMI
%token SIG
61
%token SLASH
62 63 64 65 66
%token STAR
%token STRUCT
%token THEN
%token TYPE
%token VALUE
67 68 69 70 71
%right ARROW
%right COMMA
%right GREATER GREATEREQUAL LESS LESSEQUAL LESSGREATER
%right MINUS PLUS
%right SLASH STAR
72 73 74 75 76
%type <MiniML.MLMod.mod_term> implementation
%type <MiniML.MLMod.definition> phrase
%%

path:
77
  _1 = IDENT
78 79 80
    {                    ( Pident(Ident.create _1) )}
| _1 = path _2 = DOT _3 = IDENT
    {                    ( Pdot(_1, _3) )}
81 82

valexpr:
83
  _1 = valexpr1
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
    {                                      ( _1 )}
| _1 = valexpr _2 = COMMA _3 = valexpr
    {                                      ( binop "," _1 _3 )}
| _1 = valexpr _2 = PLUS _3 = valexpr
    {                                      ( binop "+" _1 _3 )}
| _1 = valexpr _2 = MINUS _3 = valexpr
    {                                      ( binop "-" _1 _3 )}
| _1 = valexpr _2 = STAR _3 = valexpr
    {                                      ( binop "*" _1 _3 )}
| _1 = valexpr _2 = SLASH _3 = valexpr
    {                                      ( binop "/" _1 _3 )}
| _1 = valexpr _2 = EQUALEQUAL _3 = valexpr
    {                                      ( binop "==" _1 _3 )}
| _1 = valexpr _2 = LESSGREATER _3 = valexpr
    {                                      ( binop "<>" _1 _3 )}
| _1 = valexpr _2 = LESS _3 = valexpr
    {                                      ( binop "<" _1 _3 )}
| _1 = valexpr _2 = LESSEQUAL _3 = valexpr
    {                                      ( binop "<=" _1 _3 )}
| _1 = valexpr _2 = GREATER _3 = valexpr
    {                                      ( binop ">" _1 _3 )}
| _1 = valexpr _2 = GREATEREQUAL _3 = valexpr
    {                                      ( binop ">=" _1 _3 )}
| _1 = FUNCTION _2 = IDENT _3 = ARROW _4 = valexpr
    {                                      ( ML.Function(Ident.create _2, _4) )}
| _1 = LET _2 = IDENT _3 = valbind _4 = IN _5 = valexpr
    {                                      ( ML.Let(Ident.create _2, _3, _5) )}
| _1 = IF _2 = valexpr _3 = THEN _4 = valexpr _5 = ELSE _6 = valexpr
    {                                         ( ternop "conditional" _2 _4 _6 )}
113 114

valexpr1:
115
  _1 = valexpr0
116 117 118
    {             ( _1 )}
| _1 = valexpr1 _2 = valexpr0
    {                      ( ML.Apply(_1, _2) )}
119 120

valexpr0:
121
  _1 = path
122 123 124 125 126
    {         ( ML.Longident(_1) )}
| _1 = INT
    {         ( ML.Constant _1 )}
| _1 = LPAREN _2 = valexpr _3 = RPAREN
    {                          ( _2 )}
127 128

valbind:
129
  _1 = EQUAL _2 = valexpr
130 131 132
    {                      ( _2 )}
| _1 = IDENT _2 = valbind
    {                      ( ML.Function(Ident.create _1, _2) )}
133 134

simpletype:
135
  _1 = QUOTE _2 = IDENT
136 137 138 139 140 141 142 143 144 145 146
    {                            ( ML.Var(find_type_variable _2) )}
| _1 = simpletype _2 = ARROW _3 = simpletype
    {                                ( ML.Typeconstr(path_arrow, [_1; _3]) )}
| _1 = simpletype _2 = STAR _3 = simpletype
    {                                ( ML.Typeconstr(path_star, [_1; _3]) )}
| _1 = path
    {                            ( ML.Typeconstr(_1, []) )}
| _1 = simpletype _2 = path
    {                            ( ML.Typeconstr(_2, [_1]) )}
| _1 = LPAREN _2 = simpletypelist _3 = RPAREN _4 = path
    {                                      ( ML.Typeconstr(_4, List.rev _2) )}
147 148

simpletypelist:
149
  _1 = simpletype
150 151 152
    {               ( [_1] )}
| _1 = simpletypelist _2 = COMMA _3 = simpletype
    {                                    ( _3::_1 )}
153 154

valuedecl:
155
  _1 = colon_begin_scheme _2 = simpletype
156
    {            ( reset_type_variables(); end_def(); generalize _2 )}
157 158

colon_begin_scheme:
159
  _1 = COLON
160
    {            ( begin_def(); reset_type_variables() )}
161 162

typedecl:
163
  _1 = typeparams _2 = IDENT
164
    {                            ( (_2, {ML.arity = List.length _1}) )}
165 166

typedef:
167
  _1 = typeparams _2 = IDENT _3 = EQUAL _4 = simpletype
168 169
    {      ( reset_type_variables();
        (_2, {ML.arity = List.length _1}, {ML.params = _1; ML.defbody = _4}) )}
170 171

typeparams:
172
  
173 174 175 176 177
    {                                ( [] )}
| _1 = typeparam
    {                                ( [_1] )}
| _1 = LPAREN _2 = typeparamlist _3 = RPAREN
    {                                ( List.rev _2 )}
178 179

typeparamlist:
180
  _1 = typeparam
181 182 183
    {                                    ( [_1] )}
| _1 = typeparamlist _2 = COMMA _3 = typeparam
    {                                    ( _3 :: _1 )}
184 185

typeparam:
186
  _1 = QUOTE _2 = IDENT
187
    {                ( find_type_variable _2 )}
188 189

typeinfo:
190
  _1 = typedef
191 192 193 194 195
    {              ( let (id, kind, def) = _1 in
                (id, {MLMod.kind = kind; MLMod.manifest = Some def}))}
| _1 = typedecl
    {              ( let (id, kind) = _1 in
                (id, {MLMod.kind = kind; MLMod.manifest = None}) )}
196 197

modulexpr:
198
  _1 = path
199 200 201 202 203 204 205 206 207 208 209
    {                                      ( MLMod.Longident _1 )}
| _1 = STRUCT _2 = structure _3 = END
    {                                      ( MLMod.Structure(List.rev _2) )}
| _1 = FUNCTOR _2 = LPAREN _3 = IDENT _4 = COLON _5 = moduletype _6 = RPAREN _7 = modulexpr
    {                                      ( MLMod.Functor(Ident.create _3, _5, _7) )}
| _1 = modulexpr _2 = LPAREN _3 = modulexpr _4 = RPAREN
    {                                      ( MLMod.Apply(_1, _3) )}
| _1 = LPAREN _2 = modulexpr _3 = RPAREN
    {                                      ( _2 )}
| _1 = modulexpr _2 = COLON _3 = moduletype
    {                                      ( MLMod.Constraint(_1, _3) )}
210 211

structure:
212
  
213 214 215
    {                                      ( [] )}
| _1 = structure _2 = structure_item _3 = opt_semi
    {                                      ( _2 :: _1 )}
216 217

structure_item:
218
  _1 = VALUE _2 = IDENT _3 = valbind
219 220 221 222 223 224 225 226
    {                                  ( MLMod.Value_str(Ident.create _2, _3) )}
| _1 = TYPE _2 = typedef
    {                                  ( let (id, kind, def) = _2 in
                                    MLMod.Type_str(Ident.create id, kind, def) )}
| _1 = MODULE _2 = IDENT _3 = COLON _4 = moduletype _5 = EQUAL _6 = modulexpr
    {                     ( MLMod.Module_str(Ident.create _2, MLMod.Constraint(_6, _4)) )}
| _1 = MODULE _2 = IDENT _3 = EQUAL _4 = modulexpr
    {                                   ( MLMod.Module_str(Ident.create _2, _4) )}
227 228

opt_semi:
229
  
230 231 232
    {                  ( () )}
| _1 = SEMICOLON
    {              ( () )}
233 234

moduletype:
235
  _1 = SIG _2 = signature _3 = END
236 237 238 239 240
    {                                    ( MLMod.Signature(List.rev _2) )}
| _1 = FUNCTOR _2 = LPAREN _3 = IDENT _4 = COLON _5 = moduletype _6 = RPAREN _7 = moduletype
    {                                    ( MLMod.Functor_type(Ident.create _3, _5, _7) )}
| _1 = LPAREN _2 = moduletype _3 = RPAREN
    {                                    ( _2 )}
241 242

signature:
243
  
244 245 246
    {                                      ( [] )}
| _1 = signature _2 = signature_item _3 = opt_semi
    {                                      ( _2 :: _1 )}
247 248

signature_item:
249
  _1 = VALUE _2 = IDENT _3 = valuedecl
250 251 252 253 254
    {                                      ( MLMod.Value_sig(Ident.create _2, _3) )}
| _1 = TYPE _2 = typeinfo
    {                     ( let (id, def) = _2 in MLMod.Type_sig(Ident.create id, def) )}
| _1 = MODULE _2 = IDENT _3 = COLON _4 = moduletype
    {                                      ( MLMod.Module_sig(Ident.create _2, _4) )}
255 256

phrase:
257
  _1 = structure_item _2 = SEMISEMI
258 259 260
    {                                      ( _1 )}
| _1 = EOF
    {                                      ( raise End_of_file )}
261 262

implementation:
263
  _1 = modulexpr _2 = EOF
264
    {                                      ( _1 )}
265 266 267 268

%%