1072 lines
32 KiB
OCaml
1072 lines
32 KiB
OCaml
/***********************************************************************/
|
|
/* */
|
|
/* Objective Caml */
|
|
/* */
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
/* Automatique. Distributed only by permission. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
/* $Id$ */
|
|
|
|
/* The parser definition */
|
|
|
|
%{
|
|
open Location
|
|
open Asttypes
|
|
open Longident
|
|
open Parsetree
|
|
|
|
let mktyp d =
|
|
{ ptyp_desc = d; ptyp_loc = symbol_loc() }
|
|
let mkpat d =
|
|
{ ppat_desc = d; ppat_loc = symbol_loc() }
|
|
let mkexp d =
|
|
{ pexp_desc = d; pexp_loc = symbol_loc() }
|
|
let mkmty d =
|
|
{ pmty_desc = d; pmty_loc = symbol_loc() }
|
|
let mksig d =
|
|
{ psig_desc = d; psig_loc = symbol_loc() }
|
|
let mkmod d =
|
|
{ pmod_desc = d; pmod_loc = symbol_loc() }
|
|
let mkstr d =
|
|
{ pstr_desc = d; pstr_loc = symbol_loc() }
|
|
let mkfield d =
|
|
{ pfield_desc = d; pfield_loc = symbol_loc() }
|
|
|
|
let mkoperator name pos =
|
|
{ pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos }
|
|
|
|
let mkinfix arg1 name arg2 =
|
|
mkexp(Pexp_apply(mkoperator name 2, [arg1; arg2]))
|
|
|
|
let mkuminus name arg =
|
|
match arg.pexp_desc with
|
|
Pexp_constant(Const_int n) ->
|
|
mkexp(Pexp_constant(Const_int(-n)))
|
|
| Pexp_constant(Const_float f) ->
|
|
mkexp(Pexp_constant(Const_float("-" ^ f)))
|
|
| _ ->
|
|
mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [arg]))
|
|
|
|
let rec mklistexp = function
|
|
[] ->
|
|
mkexp(Pexp_construct(Lident "[]", None))
|
|
| e1 :: el ->
|
|
mkexp(Pexp_construct(Lident "::",
|
|
Some(mkexp(Pexp_tuple[e1; mklistexp el]))))
|
|
let rec mklistpat = function
|
|
[] ->
|
|
mkpat(Ppat_construct(Lident "[]", None))
|
|
| p1 :: pl ->
|
|
mkpat(Ppat_construct(Lident "::",
|
|
Some(mkpat(Ppat_tuple[p1; mklistpat pl]))))
|
|
|
|
let mkstrexp e =
|
|
{ pstr_desc = Pstr_eval e; pstr_loc = e.pexp_loc }
|
|
|
|
let array_function str name =
|
|
Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))
|
|
|
|
let rec mkrangepat c1 c2 =
|
|
if c1 > c2 then mkrangepat c2 c1 else
|
|
if c1 = c2 then mkpat(Ppat_constant(Const_char c1)) else
|
|
mkpat(Ppat_or(mkpat(Ppat_constant(Const_char c1)),
|
|
mkrangepat (Char.chr(Char.code c1 + 1)) c2))
|
|
|
|
%}
|
|
|
|
/* Tokens */
|
|
|
|
%token AMPERAMPER
|
|
%token AMPERSAND
|
|
%token AND
|
|
%token AS
|
|
%token BAR
|
|
%token BARBAR
|
|
%token BARRBRACKET
|
|
%token BEGIN
|
|
%token <char> CHAR
|
|
%token CLASS
|
|
%token CLOSED
|
|
%token COLON
|
|
%token COLONCOLON
|
|
%token COLONEQUAL
|
|
%token COLONGREATER
|
|
%token COMMA
|
|
%token CONSTRAINT
|
|
%token DO
|
|
%token DONE
|
|
%token DOT
|
|
%token DOTDOT
|
|
%token DOTLBRACKET
|
|
%token DOTLPAREN
|
|
%token DOWNTO
|
|
%token ELSE
|
|
%token END
|
|
%token EOF
|
|
%token EQUAL
|
|
%token EXCEPTION
|
|
%token EXTERNAL
|
|
%token FALSE
|
|
%token <string> FLOAT
|
|
%token FOR
|
|
%token FUN
|
|
%token FUNCTION
|
|
%token FUNCTOR
|
|
%token GREATER
|
|
%token GREATERRBRACE
|
|
%token GREATERRBRACKET
|
|
%token IF
|
|
%token IN
|
|
%token INCLUDE
|
|
%token <string> INFIXOP0
|
|
%token <string> INFIXOP1
|
|
%token <string> INFIXOP2
|
|
%token <string> INFIXOP3
|
|
%token <string> INFIXOP4
|
|
%token INHERIT
|
|
%token <int> INT
|
|
%token LBRACE
|
|
%token LBRACELESS
|
|
%token LBRACKET
|
|
%token LBRACKETBAR
|
|
%token LBRACKETLESS
|
|
%token LESS
|
|
%token LESSMINUS
|
|
%token LET
|
|
%token <string> LIDENT
|
|
%token LPAREN
|
|
%token MATCH
|
|
%token METHOD
|
|
%token MINUSGREATER
|
|
%token MODULE
|
|
%token MUTABLE
|
|
%token NEW
|
|
%token OF
|
|
%token OPEN
|
|
%token OR
|
|
%token PARSER
|
|
%token <string> PREFIXOP
|
|
%token PRIVATE
|
|
%token QUESTION
|
|
%token QUOTE
|
|
%token RBRACE
|
|
%token RBRACKET
|
|
%token REC
|
|
%token RPAREN
|
|
%token SEMI
|
|
%token SEMISEMI
|
|
%token SHARP
|
|
%token SIG
|
|
%token STAR
|
|
%token <string> STRING
|
|
%token STRUCT
|
|
%token <string> SUBTRACTIVE
|
|
%token THEN
|
|
%token TO
|
|
%token TRUE
|
|
%token TRY
|
|
%token TYPE
|
|
%token <string> UIDENT
|
|
%token UNDERSCORE
|
|
%token VAL
|
|
%token VIRTUAL
|
|
%token WHEN
|
|
%token WHILE
|
|
%token WITH
|
|
|
|
/* Precedences and associativities. Lower precedences come first. */
|
|
|
|
%right prec_let /* let ... in ... */
|
|
%right prec_type_def /* = in type definitions */
|
|
%right SEMI /* e1; e2 (sequence) */
|
|
%right prec_fun prec_match prec_try /* match ... with ... */
|
|
%right prec_list /* e1; e2 (list, array, record) */
|
|
%right prec_if /* if ... then ... else ... */
|
|
%right COLONEQUAL LESSMINUS /* assignments */
|
|
%left AS /* as in patterns */
|
|
%left BAR /* | in patterns */
|
|
%left COMMA /* , in expressions, patterns, types */
|
|
%right prec_type_arrow /* -> in type expressions */
|
|
%right OR BARBAR /* or */
|
|
%right AMPERSAND AMPERAMPER /* & */
|
|
%left INFIXOP0 EQUAL LESS GREATER /* = < > etc */
|
|
%right INFIXOP1 /* @ ^ etc */
|
|
%right COLONCOLON /* :: */
|
|
%left INFIXOP2 SUBTRACTIVE /* + - */
|
|
%left INFIXOP3 STAR /* * / */
|
|
%right INFIXOP4 /* ** */
|
|
%right prec_unary_minus /* - unary */
|
|
%left prec_appl /* function application */
|
|
%right prec_constr_appl /* constructor application */
|
|
%left SHARP /* method call */
|
|
%left DOT DOTLPAREN DOTLBRACKET /* record access, array access */
|
|
%right PREFIXOP /* ! */
|
|
|
|
/* Entry points */
|
|
|
|
%start implementation /* for implementation files */
|
|
%type <Parsetree.structure> implementation
|
|
%start interface /* for interface files */
|
|
%type <Parsetree.signature> interface
|
|
%start toplevel_phrase /* for interactive use */
|
|
%type <Parsetree.toplevel_phrase> toplevel_phrase
|
|
%start use_file /* for the #use directive */
|
|
%type <Parsetree.toplevel_phrase list> use_file
|
|
|
|
%%
|
|
|
|
/* Entry points */
|
|
|
|
implementation:
|
|
structure EOF { $1 }
|
|
;
|
|
interface:
|
|
signature EOF { List.rev $1 }
|
|
;
|
|
toplevel_phrase:
|
|
structure_item SEMISEMI { Ptop_def[$1] }
|
|
| expr SEMISEMI { Ptop_def[mkstrexp $1] }
|
|
| toplevel_directive SEMISEMI { $1 }
|
|
| EOF { raise End_of_file }
|
|
;
|
|
use_file:
|
|
use_file_tail { $1 }
|
|
| expr use_file_tail { Ptop_def[mkstrexp $1] :: $2 }
|
|
;
|
|
use_file_tail:
|
|
EOF { [] }
|
|
| SEMISEMI EOF { [] }
|
|
| SEMISEMI expr use_file_tail { Ptop_def[mkstrexp $2] :: $3 }
|
|
| SEMISEMI structure_item use_file_tail { Ptop_def[$2] :: $3 }
|
|
| SEMISEMI toplevel_directive use_file_tail { $2 :: $3 }
|
|
| structure_item use_file_tail { Ptop_def[$1] :: $2 }
|
|
| toplevel_directive use_file_tail { $1 :: $2 }
|
|
;
|
|
|
|
/* Module expressions */
|
|
|
|
module_expr:
|
|
mod_longident
|
|
{ mkmod(Pmod_ident $1) }
|
|
| STRUCT structure END
|
|
{ mkmod(Pmod_structure($2)) }
|
|
| FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
|
|
%prec prec_fun
|
|
{ mkmod(Pmod_functor($3, $5, $8)) }
|
|
| module_expr LPAREN module_expr RPAREN
|
|
{ mkmod(Pmod_apply($1, $3)) }
|
|
| LPAREN module_expr COLON module_type RPAREN
|
|
{ mkmod(Pmod_constraint($2, $4)) }
|
|
| LPAREN module_expr RPAREN
|
|
{ $2 }
|
|
;
|
|
structure:
|
|
structure_tail { $1 }
|
|
| expr structure_tail { mkstrexp $1 :: $2 }
|
|
;
|
|
structure_tail:
|
|
/* empty */ { [] }
|
|
| SEMISEMI { [] }
|
|
| SEMISEMI expr structure_tail { mkstrexp $2 :: $3 }
|
|
| SEMISEMI structure_item structure_tail { $2 :: $3 }
|
|
| structure_item structure_tail { $1 :: $2 }
|
|
;
|
|
structure_item:
|
|
LET rec_flag let_bindings
|
|
{ match $3 with
|
|
[{ppat_desc = Ppat_any}, exp] -> mkstr(Pstr_eval exp)
|
|
| _ -> mkstr(Pstr_value($2, List.rev $3)) }
|
|
| EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
|
|
{ mkstr(Pstr_primitive($2, {pval_type = $4; pval_prim = $6})) }
|
|
| TYPE type_declarations
|
|
{ mkstr(Pstr_type(List.rev $2)) }
|
|
| EXCEPTION UIDENT constructor_arguments
|
|
{ mkstr(Pstr_exception($2, $3)) }
|
|
| MODULE UIDENT module_binding
|
|
{ mkstr(Pstr_module($2, $3)) }
|
|
| MODULE TYPE ident EQUAL module_type
|
|
{ mkstr(Pstr_modtype($3, $5)) }
|
|
| OPEN mod_longident
|
|
{ mkstr(Pstr_open $2) }
|
|
| CLASS class_list END
|
|
{ mkstr(Pstr_class (List.rev $2)) }
|
|
;
|
|
module_binding:
|
|
EQUAL module_expr
|
|
{ $2 }
|
|
| COLON module_type EQUAL module_expr
|
|
{ mkmod(Pmod_constraint($4, $2)) }
|
|
| LPAREN UIDENT COLON module_type RPAREN module_binding
|
|
{ mkmod(Pmod_functor($2, $4, $6)) }
|
|
;
|
|
|
|
/* Module types */
|
|
|
|
module_type:
|
|
mty_longident
|
|
{ mkmty(Pmty_ident $1) }
|
|
| SIG signature END
|
|
{ mkmty(Pmty_signature(List.rev $2)) }
|
|
| FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
|
|
%prec prec_fun
|
|
{ mkmty(Pmty_functor($3, $5, $8)) }
|
|
| module_type WITH with_constraints
|
|
{ mkmty(Pmty_with($1, List.rev $3)) }
|
|
| LPAREN module_type RPAREN
|
|
{ $2 }
|
|
;
|
|
signature:
|
|
/* empty */ { [] }
|
|
| signature signature_item { $2 :: $1 }
|
|
| signature signature_item SEMISEMI { $2 :: $1 }
|
|
;
|
|
signature_item:
|
|
VAL val_ident COLON core_type
|
|
{ mksig(Psig_value($2, {pval_type = $4; pval_prim = []})) }
|
|
| EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
|
|
{ mksig(Psig_value($2, {pval_type = $4; pval_prim = $6})) }
|
|
| TYPE type_declarations
|
|
{ mksig(Psig_type(List.rev $2)) }
|
|
| EXCEPTION UIDENT constructor_arguments
|
|
{ mksig(Psig_exception($2, $3)) }
|
|
| MODULE UIDENT module_declaration
|
|
{ mksig(Psig_module($2, $3)) }
|
|
| MODULE TYPE ident
|
|
{ mksig(Psig_modtype($3, Pmodtype_abstract)) }
|
|
| MODULE TYPE ident EQUAL module_type
|
|
{ mksig(Psig_modtype($3, Pmodtype_manifest $5)) }
|
|
| OPEN mod_longident
|
|
{ mksig(Psig_open $2) }
|
|
| INCLUDE module_type
|
|
{ mksig(Psig_include $2) }
|
|
| CLASS class_type_list END
|
|
{ mksig(Psig_class (List.rev $2)) }
|
|
;
|
|
|
|
module_declaration:
|
|
COLON module_type
|
|
{ $2 }
|
|
| LPAREN UIDENT COLON module_type RPAREN module_declaration
|
|
{ mkmty(Pmty_functor($2, $4, $6)) }
|
|
;
|
|
|
|
/* Core expressions */
|
|
|
|
expr:
|
|
simple_expr
|
|
{ $1 }
|
|
| simple_expr simple_expr_list %prec prec_appl
|
|
{ mkexp(Pexp_apply($1, List.rev $2)) }
|
|
| LET rec_flag let_bindings IN expr %prec prec_let
|
|
{ mkexp(Pexp_let($2, List.rev $3, $5)) }
|
|
| PARSER opt_pat opt_bar parser_cases %prec prec_fun
|
|
{ Pstream.cparser ($2, List.rev $4) }
|
|
| FUNCTION opt_bar match_cases %prec prec_fun
|
|
{ mkexp(Pexp_function(List.rev $3)) }
|
|
| FUN simple_pattern fun_def %prec prec_fun
|
|
{ mkexp(Pexp_function([$2, $3])) }
|
|
| MATCH expr WITH opt_bar match_cases %prec prec_match
|
|
{ mkexp(Pexp_match($2, List.rev $5)) }
|
|
| MATCH expr WITH PARSER opt_pat opt_bar parser_cases %prec prec_match
|
|
{ mkexp(Pexp_apply(Pstream.cparser ($5, List.rev $7), [$2])) }
|
|
| TRY expr WITH opt_bar match_cases %prec prec_try
|
|
{ mkexp(Pexp_try($2, List.rev $5)) }
|
|
| expr_comma_list
|
|
{ mkexp(Pexp_tuple(List.rev $1)) }
|
|
| constr_longident simple_expr %prec prec_constr_appl
|
|
{ mkexp(Pexp_construct($1, Some $2)) }
|
|
| IF expr THEN expr ELSE expr %prec prec_if
|
|
{ mkexp(Pexp_ifthenelse($2, $4, Some $6)) }
|
|
| IF expr THEN expr %prec prec_if
|
|
{ mkexp(Pexp_ifthenelse($2, $4, None)) }
|
|
| expr SEMI expr
|
|
{ mkexp(Pexp_sequence($1, $3)) }
|
|
| expr SEMI
|
|
{ mkexp(Pexp_sequence($1, mkexp(Pexp_construct(Lident "()", None)))) }
|
|
| WHILE expr DO expr DONE
|
|
{ mkexp(Pexp_while($2, $4)) }
|
|
| FOR val_ident EQUAL expr direction_flag expr DO expr DONE
|
|
{ mkexp(Pexp_for($2, $4, $6, $5, $8)) }
|
|
| expr COLONCOLON expr
|
|
{ mkexp(Pexp_construct(Lident "::", Some(mkexp(Pexp_tuple[$1;$3])))) }
|
|
| expr INFIXOP0 expr
|
|
{ mkinfix $1 $2 $3 }
|
|
| expr INFIXOP1 expr
|
|
{ mkinfix $1 $2 $3 }
|
|
| expr INFIXOP2 expr
|
|
{ mkinfix $1 $2 $3 }
|
|
| expr INFIXOP3 expr
|
|
{ mkinfix $1 $2 $3 }
|
|
| expr INFIXOP4 expr
|
|
{ mkinfix $1 $2 $3 }
|
|
| expr SUBTRACTIVE expr
|
|
{ mkinfix $1 $2 $3 }
|
|
| expr STAR expr
|
|
{ mkinfix $1 "*" $3 }
|
|
| expr EQUAL expr
|
|
{ mkinfix $1 "=" $3 }
|
|
| expr LESS expr
|
|
{ mkinfix $1 "<" $3 }
|
|
| expr GREATER expr
|
|
{ mkinfix $1 ">" $3 }
|
|
| expr OR expr
|
|
{ mkinfix $1 "or" $3 }
|
|
| expr BARBAR expr
|
|
{ mkinfix $1 "||" $3 }
|
|
| expr AMPERSAND expr
|
|
{ mkinfix $1 "&" $3 }
|
|
| expr AMPERAMPER expr
|
|
{ mkinfix $1 "&&" $3 }
|
|
| expr COLONEQUAL expr
|
|
{ mkinfix $1 ":=" $3 }
|
|
| SUBTRACTIVE expr %prec prec_unary_minus
|
|
{ mkuminus $1 $2 }
|
|
| simple_expr DOT label_longident LESSMINUS expr
|
|
{ mkexp(Pexp_setfield($1, $3, $5)) }
|
|
| simple_expr DOT LPAREN expr RPAREN LESSMINUS expr
|
|
{ mkexp(Pexp_apply(mkexp(Pexp_ident(array_function "Array" "set")),
|
|
[$1; $4; $7])) }
|
|
| simple_expr DOT LBRACKET expr RBRACKET LESSMINUS expr
|
|
{ mkexp(Pexp_apply(mkexp(Pexp_ident(array_function "String" "set")),
|
|
[$1; $4; $7])) }
|
|
| label LESSMINUS expr
|
|
{ mkexp(Pexp_setinstvar($1, $3)) }
|
|
;
|
|
simple_expr:
|
|
val_longident
|
|
{ mkexp(Pexp_ident $1) }
|
|
| constant
|
|
{ mkexp(Pexp_constant $1) }
|
|
| constr_longident
|
|
{ mkexp(Pexp_construct($1, None)) }
|
|
| LPAREN expr RPAREN
|
|
{ $2 }
|
|
| BEGIN expr END
|
|
{ $2 }
|
|
| LPAREN expr type_constraint RPAREN
|
|
{ let (t, t') = $3 in mkexp(Pexp_constraint($2, t, t')) }
|
|
| simple_expr DOT label_longident
|
|
{ mkexp(Pexp_field($1, $3)) }
|
|
| simple_expr DOT LPAREN expr RPAREN
|
|
{ mkexp(Pexp_apply(mkexp(Pexp_ident(array_function "Array" "get")),
|
|
[$1; $4])) }
|
|
| simple_expr DOT LBRACKET expr RBRACKET
|
|
{ mkexp(Pexp_apply(mkexp(Pexp_ident(array_function "String" "get")),
|
|
[$1; $4])) }
|
|
| LBRACE lbl_expr_list RBRACE
|
|
{ mkexp(Pexp_record(List.rev $2)) }
|
|
| LBRACKETLESS stream_expr GREATERRBRACKET
|
|
{ Pstream.cstream (List.rev $2) }
|
|
| LBRACKETLESS GREATERRBRACKET
|
|
{ Pstream.cstream [] }
|
|
| LBRACKETBAR expr_semi_list BARRBRACKET
|
|
{ mkexp(Pexp_array(List.rev $2)) }
|
|
| LBRACKETBAR BARRBRACKET
|
|
{ mkexp(Pexp_array []) }
|
|
| LBRACKET expr_semi_list RBRACKET
|
|
{ mklistexp(List.rev $2) }
|
|
| PREFIXOP simple_expr
|
|
{ mkexp(Pexp_apply(mkoperator $1 1, [$2])) }
|
|
| simple_expr SHARP label
|
|
{ mkexp(Pexp_send($1, $3)) }
|
|
| NEW class_longident
|
|
{ mkexp(Pexp_new($2)) }
|
|
| LBRACELESS label_expr_list GREATERRBRACE
|
|
{ mkexp(Pexp_override(List.rev $2)) }
|
|
| LBRACELESS GREATERRBRACE
|
|
{ mkexp(Pexp_override []) }
|
|
| LPAREN SHARP label RPAREN
|
|
{ mkexp(Pexp_function [mkpat(Ppat_var "x"),
|
|
mkexp(Pexp_send(mkexp(Pexp_ident (Lident"x")), $3))]) }
|
|
;
|
|
simple_expr_list:
|
|
simple_expr
|
|
{ [$1] }
|
|
| simple_expr_list simple_expr
|
|
{ $2 :: $1 }
|
|
;
|
|
let_bindings:
|
|
let_binding { [$1] }
|
|
| let_bindings AND let_binding { $3 :: $1 }
|
|
;
|
|
let_binding:
|
|
val_ident fun_binding
|
|
{ ({ppat_desc = Ppat_var $1; ppat_loc = rhs_loc 1}, $2) }
|
|
| pattern EQUAL expr
|
|
{ ($1, $3) }
|
|
;
|
|
fun_binding:
|
|
EQUAL expr %prec prec_let
|
|
{ $2 }
|
|
| type_constraint EQUAL expr %prec prec_let
|
|
{ let (t, t') = $1 in mkexp(Pexp_constraint($3, t, t')) }
|
|
| simple_pattern fun_binding
|
|
{ mkexp(Pexp_function[$1,$2]) }
|
|
;
|
|
parser_cases:
|
|
parser_case { [$1] }
|
|
| parser_cases BAR parser_case { $3 :: $1 }
|
|
;
|
|
parser_case:
|
|
LBRACKETLESS stream_pattern GREATERRBRACKET opt_pat MINUSGREATER expr
|
|
{ (List.rev $2, $4, $6) }
|
|
| LBRACKETLESS GREATERRBRACKET opt_pat MINUSGREATER expr
|
|
{ ([], $3, $5) }
|
|
;
|
|
stream_pattern:
|
|
stream_pattern_component opt_err { [($1, $2)] }
|
|
| stream_pattern SEMI stream_pattern_component opt_err { ($3, $4) :: $1 }
|
|
;
|
|
stream_pattern_component:
|
|
QUOTE pattern
|
|
{ Pstream.Spat_term ($2, None) }
|
|
| QUOTE pattern WHEN expr %prec prec_list
|
|
{ Pstream.Spat_term ($2, Some $4) }
|
|
| pattern EQUAL expr
|
|
{ Pstream.Spat_nterm ($1, $3) }
|
|
| pattern
|
|
{ Pstream.Spat_sterm $1 }
|
|
;
|
|
opt_pat:
|
|
/* empty */ { None }
|
|
| simple_pattern { Some $1 }
|
|
;
|
|
opt_err:
|
|
/* empty */ { None }
|
|
| QUESTION expr %prec prec_list { Some $2 }
|
|
;
|
|
stream_expr:
|
|
stream_expr_component { [$1] }
|
|
| stream_expr SEMI stream_expr_component { $3 :: $1 }
|
|
;
|
|
stream_expr_component:
|
|
QUOTE expr %prec prec_list { Pstream.Sexp_term $2 }
|
|
| expr %prec prec_list { Pstream.Sexp_nterm $1 }
|
|
;
|
|
match_cases:
|
|
pattern match_action { [$1, $2] }
|
|
| match_cases BAR pattern match_action { ($3, $4) :: $1 }
|
|
;
|
|
fun_def:
|
|
match_action { $1 }
|
|
| simple_pattern fun_def { mkexp(Pexp_function[$1,$2]) }
|
|
;
|
|
match_action:
|
|
MINUSGREATER expr { $2 }
|
|
| WHEN expr MINUSGREATER expr { mkexp(Pexp_when($2, $4)) }
|
|
;
|
|
expr_comma_list:
|
|
expr_comma_list COMMA expr { $3 :: $1 }
|
|
| expr COMMA expr { [$3; $1] }
|
|
;
|
|
lbl_expr_list:
|
|
label_longident EQUAL expr %prec prec_list
|
|
{ [$1,$3] }
|
|
| lbl_expr_list SEMI label_longident EQUAL expr %prec prec_list
|
|
{ ($3, $5) :: $1 }
|
|
;
|
|
label_expr_list:
|
|
label EQUAL expr %prec prec_list
|
|
{ [$1,$3] }
|
|
| label_expr_list SEMI label EQUAL expr %prec prec_list
|
|
{ ($3, $5) :: $1 }
|
|
;
|
|
expr_semi_list:
|
|
expr %prec prec_list { [$1] }
|
|
| expr_semi_list SEMI expr %prec prec_list { $3 :: $1 }
|
|
;
|
|
type_constraint:
|
|
COLON core_type
|
|
{ (Some $2, None) }
|
|
| COLON core_type COLONGREATER core_type
|
|
{ (Some $2, Some $4) }
|
|
| COLONGREATER core_type
|
|
{ (None, Some $2) }
|
|
;
|
|
|
|
/* Patterns */
|
|
|
|
pattern:
|
|
simple_pattern
|
|
{ $1 }
|
|
| pattern AS val_ident
|
|
{ mkpat(Ppat_alias($1, $3)) }
|
|
| pattern_comma_list
|
|
{ mkpat(Ppat_tuple(List.rev $1)) }
|
|
| constr_longident pattern %prec prec_constr_appl
|
|
{ mkpat(Ppat_construct($1, Some $2)) }
|
|
| pattern COLONCOLON pattern
|
|
{ mkpat(Ppat_construct(Lident "::", Some(mkpat(Ppat_tuple[$1;$3])))) }
|
|
| pattern BAR pattern
|
|
{ mkpat(Ppat_or($1, $3)) }
|
|
;
|
|
simple_pattern:
|
|
val_ident
|
|
{ mkpat(Ppat_var $1) }
|
|
| UNDERSCORE
|
|
{ mkpat(Ppat_any) }
|
|
| signed_constant
|
|
{ mkpat(Ppat_constant $1) }
|
|
| CHAR DOTDOT CHAR
|
|
{ mkrangepat $1 $3 }
|
|
| constr_longident
|
|
{ mkpat(Ppat_construct($1, None)) }
|
|
| LBRACE lbl_pattern_list RBRACE
|
|
{ mkpat(Ppat_record(List.rev $2)) }
|
|
| LBRACKET pattern_semi_list RBRACKET
|
|
{ mklistpat(List.rev $2) }
|
|
| LPAREN pattern RPAREN
|
|
{ $2 }
|
|
| LPAREN pattern COLON core_type RPAREN
|
|
{ mkpat(Ppat_constraint($2, $4)) }
|
|
;
|
|
|
|
pattern_comma_list:
|
|
pattern_comma_list COMMA pattern { $3 :: $1 }
|
|
| pattern COMMA pattern { [$3; $1] }
|
|
;
|
|
pattern_semi_list:
|
|
pattern { [$1] }
|
|
| pattern_semi_list SEMI pattern { $3 :: $1 }
|
|
;
|
|
lbl_pattern_list:
|
|
label_longident EQUAL pattern { [($1, $3)] }
|
|
| lbl_pattern_list SEMI label_longident EQUAL pattern { ($3, $5) :: $1 }
|
|
;
|
|
|
|
/* Primitive declarations */
|
|
|
|
primitive_declaration:
|
|
STRING { [$1] }
|
|
| STRING primitive_declaration { $1 :: $2 }
|
|
;
|
|
|
|
/* Class definitions */
|
|
|
|
class_list:
|
|
class_list AND class_def
|
|
{ $3 :: $1 }
|
|
| class_def
|
|
{ [$1] }
|
|
;
|
|
class_def:
|
|
virtual_flag closed_flag
|
|
class_type_parameters LIDENT simple_pattern_list self self_type EQUAL
|
|
constraints class_fields
|
|
{ { pcl_name = $4; pcl_param = $3; pcl_args = List.rev $5;
|
|
pcl_self = $6; pcl_self_ty = $7; pcl_cstr = List.rev $9;
|
|
pcl_field = List.rev $10;
|
|
pcl_kind = $1; pcl_closed = $2;
|
|
pcl_loc = symbol_loc () } }
|
|
;
|
|
class_type_parameters:
|
|
type_parameters
|
|
{ $1, symbol_loc () }
|
|
;
|
|
simple_pattern_list:
|
|
simple_pattern
|
|
{ [$1] }
|
|
| simple_pattern_list simple_pattern
|
|
{ $2::$1 }
|
|
;
|
|
self:
|
|
AS LIDENT
|
|
{ Some $2 }
|
|
| /* empty */
|
|
{ None }
|
|
;
|
|
class_fields:
|
|
/* empty */
|
|
{ [] }
|
|
| class_fields INHERIT ancestor
|
|
{ Pcf_inher $3 :: $1 }
|
|
| class_fields VAL value
|
|
{ Pcf_val $3 :: $1 }
|
|
| class_fields VIRTUAL method_type
|
|
{ Pcf_virt $3 :: $1 }
|
|
| class_fields METHOD method_def
|
|
{ Pcf_meth $3 :: $1 }
|
|
;
|
|
ancestor:
|
|
LPAREN core_type_comma_list RPAREN class_longident simple_expr_list
|
|
self
|
|
{ $4, List.rev $2, List.rev $5, $6, symbol_loc () }
|
|
| LPAREN core_type RPAREN class_longident simple_expr_list self
|
|
{ $4, [$2], List.rev $5, $6, symbol_loc () }
|
|
| class_longident simple_expr_list self
|
|
{ $1, [], List.rev $2, $3, symbol_loc () }
|
|
;
|
|
value:
|
|
private_flag mutable_flag label EQUAL expr
|
|
{ $3, $1, $2, Some $5, symbol_loc () }
|
|
| private_flag mutable_flag label
|
|
{ $3, $1, $2, None, symbol_loc () }
|
|
;
|
|
method_def :
|
|
label fun_binding
|
|
{ $1, $2, symbol_loc () }
|
|
;
|
|
|
|
/* Class type definitions */
|
|
|
|
class_type_list:
|
|
class_type_list AND class_type
|
|
{ $3 :: $1 }
|
|
| class_type
|
|
{ [$1] }
|
|
;
|
|
class_type:
|
|
virtual_flag closed_flag class_type_parameters LIDENT type_list
|
|
self_type
|
|
EQUAL
|
|
constraints class_type_fields
|
|
{ { pcty_name = $4; pcty_param = $3; pcty_args = $5;
|
|
pcty_self = $6; pcty_cstr = List.rev $8;
|
|
pcty_field = List.rev $9;
|
|
pcty_kind = $1; pcty_closed = $2;
|
|
pcty_loc = symbol_loc () } }
|
|
;
|
|
type_list:
|
|
LPAREN core_type RPAREN type_list
|
|
{ $2 :: $4 }
|
|
| LPAREN core_type RPAREN
|
|
{ [$2] }
|
|
;
|
|
self_type:
|
|
COLON type_parameter
|
|
{ Some $2 }
|
|
| /* empty */
|
|
{ None }
|
|
;
|
|
constraints:
|
|
constraints CONSTRAINT constrain
|
|
{ $3 :: $1 }
|
|
| /* empty */
|
|
{ [] }
|
|
;
|
|
constrain:
|
|
type_parameter EQUAL core_type
|
|
{ $1, $3, symbol_loc () }
|
|
;
|
|
class_type_fields:
|
|
/* empty */
|
|
{ [] }
|
|
| class_type_fields INHERIT ancestor_type
|
|
{ Pctf_inher $3 :: $1 }
|
|
| class_type_fields VAL value_type
|
|
{ Pctf_val $3 :: $1 }
|
|
| class_type_fields VIRTUAL method_type
|
|
{ Pctf_virt $3 :: $1 }
|
|
| class_type_fields METHOD method_type_opt
|
|
{ Pctf_meth $3 :: $1 }
|
|
;
|
|
ancestor_type:
|
|
LPAREN core_type_comma_list RPAREN class_longident
|
|
{ $4, List.rev $2, symbol_loc () }
|
|
| LPAREN core_type RPAREN class_longident
|
|
{ $4, [$2], symbol_loc () }
|
|
| class_longident
|
|
{ $1, [], symbol_loc () }
|
|
;
|
|
value_type :
|
|
private_flag mutable_flag label COLON core_type
|
|
{ $3, $1, $2, Some $5, symbol_loc () }
|
|
| private_flag mutable_flag label
|
|
{ $3, $1, $2, None, symbol_loc () }
|
|
;
|
|
method_type :
|
|
label COLON core_type
|
|
{ $1, $3, symbol_loc () }
|
|
;
|
|
method_type_opt :
|
|
label COLON core_type
|
|
{ $1, Some $3, symbol_loc () }
|
|
| label
|
|
{ $1, None, symbol_loc () }
|
|
;
|
|
|
|
/* Type declarations */
|
|
|
|
type_declarations:
|
|
type_declaration { [$1] }
|
|
| type_declarations AND type_declaration { $3 :: $1 }
|
|
;
|
|
type_declaration:
|
|
type_parameters LIDENT type_kind
|
|
{ let (kind, manifest) = $3 in
|
|
($2, {ptype_params = $1;
|
|
ptype_kind = kind;
|
|
ptype_manifest = manifest;
|
|
ptype_loc = symbol_loc()}) }
|
|
;
|
|
type_kind:
|
|
/*empty*/
|
|
{ (Ptype_abstract, None) }
|
|
| EQUAL core_type %prec prec_type_def
|
|
{ (Ptype_abstract, Some $2) }
|
|
| EQUAL constructor_declarations
|
|
{ (Ptype_variant(List.rev $2), None) }
|
|
| EQUAL BAR constructor_declarations
|
|
{ (Ptype_variant(List.rev $3), None) }
|
|
| EQUAL LBRACE label_declarations RBRACE
|
|
{ (Ptype_record(List.rev $3), None) }
|
|
| EQUAL core_type EQUAL constructor_declarations %prec prec_type_def
|
|
{ (Ptype_variant(List.rev $4), Some $2) }
|
|
| EQUAL core_type EQUAL BAR constructor_declarations %prec prec_type_def
|
|
{ (Ptype_variant(List.rev $5), Some $2) }
|
|
| EQUAL core_type EQUAL LBRACE label_declarations RBRACE %prec prec_type_def
|
|
{ (Ptype_record(List.rev $5), Some $2) }
|
|
;
|
|
type_parameters:
|
|
/*empty*/ { [] }
|
|
| type_parameter { [$1] }
|
|
| LPAREN type_parameter_list RPAREN { List.rev $2 }
|
|
;
|
|
type_parameter:
|
|
QUOTE ident { $2 }
|
|
;
|
|
type_parameter_list:
|
|
type_parameter { [$1] }
|
|
| type_parameter_list COMMA type_parameter { $3 :: $1 }
|
|
;
|
|
constructor_declarations:
|
|
constructor_declaration { [$1] }
|
|
| constructor_declarations BAR constructor_declaration { $3 :: $1 }
|
|
;
|
|
constructor_declaration:
|
|
constr_ident constructor_arguments { ($1, $2) }
|
|
;
|
|
constructor_arguments:
|
|
/*empty*/ { [] }
|
|
| OF core_type_list { List.rev $2 }
|
|
;
|
|
label_declarations:
|
|
label_declaration { [$1] }
|
|
| label_declarations SEMI label_declaration { $3 :: $1 }
|
|
;
|
|
label_declaration:
|
|
mutable_flag LIDENT COLON core_type { ($2, $1, $4) }
|
|
;
|
|
|
|
/* "with" constraints (additional type equations over signature components) */
|
|
|
|
with_constraints:
|
|
with_constraint { [$1] }
|
|
| with_constraints AND with_constraint { $3 :: $1 }
|
|
;
|
|
with_constraint:
|
|
TYPE type_parameters label_longident EQUAL core_type
|
|
{ ($3, Pwith_type {ptype_params = $2;
|
|
ptype_kind = Ptype_abstract;
|
|
ptype_manifest = Some $5;
|
|
ptype_loc = symbol_loc()}) }
|
|
/* used label_longident instead of type_longident to disallow
|
|
functor applications in type path */
|
|
| MODULE mod_longident EQUAL mod_ext_longident
|
|
{ ($2, Pwith_module $4) }
|
|
;
|
|
|
|
/* Core types */
|
|
|
|
core_type:
|
|
simple_core_type
|
|
{ $1 }
|
|
| core_type MINUSGREATER core_type %prec prec_type_arrow
|
|
{ mktyp(Ptyp_arrow($1, $3)) }
|
|
| core_type_tuple
|
|
{ mktyp(Ptyp_tuple(List.rev $1)) }
|
|
;
|
|
|
|
simple_core_type:
|
|
QUOTE ident
|
|
{ mktyp(Ptyp_var $2) }
|
|
| type_longident alias
|
|
{ mktyp(Ptyp_constr($1, [], $2)) }
|
|
| simple_core_type type_longident alias %prec prec_constr_appl
|
|
{ mktyp(Ptyp_constr($2, [$1], $3)) }
|
|
| LPAREN core_type_comma_list RPAREN type_longident alias
|
|
%prec prec_constr_appl
|
|
{ mktyp(Ptyp_constr($4, List.rev $2, $5)) }
|
|
| LPAREN core_type RPAREN
|
|
{ $2 }
|
|
| LESS meth_list GREATER alias
|
|
{ mktyp(Ptyp_object($2, $4)) }
|
|
| LESS GREATER alias
|
|
{ mktyp(Ptyp_object([], $3)) }
|
|
| SHARP class_longident alias
|
|
{ mktyp(Ptyp_class($2, [], $3)) }
|
|
| simple_core_type SHARP class_longident alias %prec prec_constr_appl
|
|
{ mktyp(Ptyp_class($3, [$1], $4)) }
|
|
| LPAREN core_type_comma_list RPAREN SHARP class_longident alias
|
|
%prec prec_constr_appl
|
|
{ mktyp(Ptyp_class($5, List.rev $2, $6)) }
|
|
;
|
|
alias:
|
|
AS type_parameter
|
|
{ Some $2 }
|
|
| /* empty */
|
|
{None}
|
|
;
|
|
core_type_tuple:
|
|
simple_core_type STAR simple_core_type
|
|
{ [$3; $1] }
|
|
| core_type_tuple STAR simple_core_type
|
|
{ $3 :: $1 }
|
|
;
|
|
core_type_comma_list:
|
|
core_type COMMA core_type { [$3; $1] }
|
|
| core_type_comma_list COMMA core_type { $3 :: $1 }
|
|
;
|
|
core_type_list:
|
|
simple_core_type { [$1] }
|
|
| core_type_list STAR simple_core_type { $3 :: $1 }
|
|
;
|
|
meth_list:
|
|
field SEMI meth_list
|
|
{ $1 :: $3 }
|
|
| field
|
|
{ [$1] }
|
|
| DOTDOT
|
|
{ [mkfield Pfield_var] }
|
|
;
|
|
field:
|
|
label COLON core_type
|
|
{ mkfield(Pfield($1, $3)) }
|
|
;
|
|
label:
|
|
LIDENT
|
|
{ $1 }
|
|
;
|
|
|
|
/* Constants */
|
|
|
|
constant:
|
|
INT { Const_int $1 }
|
|
| CHAR { Const_char $1 }
|
|
| STRING { Const_string $1 }
|
|
| FLOAT { Const_float $1 }
|
|
;
|
|
signed_constant:
|
|
constant { $1 }
|
|
| SUBTRACTIVE INT { Const_int(- $2) }
|
|
| SUBTRACTIVE FLOAT { Const_float("-" ^ $2) }
|
|
;
|
|
/* Identifiers and long identifiers */
|
|
|
|
ident:
|
|
UIDENT { $1 }
|
|
| LIDENT { $1 }
|
|
;
|
|
val_ident:
|
|
LIDENT { $1 }
|
|
| LPAREN operator RPAREN { $2 }
|
|
;
|
|
operator:
|
|
PREFIXOP { $1 }
|
|
| INFIXOP0 { $1 }
|
|
| INFIXOP1 { $1 }
|
|
| INFIXOP2 { $1 }
|
|
| INFIXOP3 { $1 }
|
|
| INFIXOP4 { $1 }
|
|
| SUBTRACTIVE { $1 }
|
|
| STAR { "*" }
|
|
| EQUAL { "=" }
|
|
| LESS { "<" }
|
|
| GREATER { ">" }
|
|
| OR { "or" }
|
|
| BARBAR { "||" }
|
|
| AMPERSAND { "&" }
|
|
| AMPERAMPER { "&&" }
|
|
| COLONEQUAL { ":=" }
|
|
;
|
|
constr_ident:
|
|
UIDENT { $1 }
|
|
| LBRACKET RBRACKET { "[]" }
|
|
| LPAREN RPAREN { "()" }
|
|
| COLONCOLON { "::" }
|
|
| FALSE { "false" }
|
|
| TRUE { "true" }
|
|
;
|
|
|
|
val_longident:
|
|
val_ident { Lident $1 }
|
|
| mod_longident DOT val_ident { Ldot($1, $3) }
|
|
;
|
|
constr_longident:
|
|
mod_longident { $1 }
|
|
| LBRACKET RBRACKET { Lident "[]" }
|
|
| LPAREN RPAREN { Lident "()" }
|
|
| FALSE { Lident "false" }
|
|
| TRUE { Lident "true" }
|
|
;
|
|
label_longident:
|
|
LIDENT { Lident $1 }
|
|
| mod_longident DOT LIDENT { Ldot($1, $3) }
|
|
;
|
|
type_longident:
|
|
LIDENT { Lident $1 }
|
|
| mod_ext_longident DOT LIDENT { Ldot($1, $3) }
|
|
;
|
|
mod_longident:
|
|
UIDENT { Lident $1 }
|
|
| mod_longident DOT UIDENT { Ldot($1, $3) }
|
|
;
|
|
mod_ext_longident:
|
|
UIDENT { Lident $1 }
|
|
| mod_ext_longident DOT UIDENT { Ldot($1, $3) }
|
|
| mod_ext_longident LPAREN mod_ext_longident RPAREN { Lapply($1, $3) }
|
|
;
|
|
mty_longident:
|
|
ident { Lident $1 }
|
|
| mod_ext_longident DOT ident { Ldot($1, $3) }
|
|
;
|
|
class_longident:
|
|
LIDENT { Lident $1 }
|
|
| mod_longident DOT LIDENT { Ldot($1, $3) }
|
|
;
|
|
|
|
/* Toplevel directives */
|
|
|
|
toplevel_directive:
|
|
SHARP ident { Ptop_dir($2, Pdir_none) }
|
|
| SHARP ident STRING { Ptop_dir($2, Pdir_string $3) }
|
|
| SHARP ident INT { Ptop_dir($2, Pdir_int $3) }
|
|
| SHARP ident val_longident { Ptop_dir($2, Pdir_ident $3) }
|
|
;
|
|
|
|
/* Miscellaneous */
|
|
|
|
rec_flag:
|
|
/* empty */ { Nonrecursive }
|
|
| REC { Recursive }
|
|
;
|
|
direction_flag:
|
|
TO { Upto }
|
|
| DOWNTO { Downto }
|
|
;
|
|
private_flag:
|
|
/* empty */ { Public }
|
|
| PRIVATE { Private }
|
|
;
|
|
mutable_flag:
|
|
/* empty */ { Immutable }
|
|
| MUTABLE { Mutable }
|
|
;
|
|
virtual_flag:
|
|
/* empty */ { Concrete }
|
|
| VIRTUAL { Virtual }
|
|
;
|
|
closed_flag:
|
|
/* empty */ { Open }
|
|
| CLOSED { Closed }
|
|
;
|
|
opt_bar:
|
|
/* empty */ { () }
|
|
| BAR { () }
|
|
;
|
|
%%
|