/***********************************************************************/
/*                                                                     */
/*                           Objective Caml                            */
/*                                                                     */
/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
/*                                                                     */
/*  Copyright 1996 Institut National de Recherche en Informatique et   */
/*  en Automatique.  All rights reserved.  This file is distributed    */
/*  under the terms of the Q Public License version 1.0.               */
/*                                                                     */
/***********************************************************************/

/* $Id$ */

/* The parser definition */

%{
open Location
open Asttypes
open Longident
open Parsetree

let mktyp d =
  { ptyp_desc = d; ptyp_loc = symbol_rloc() }
let mkpat d =
  { ppat_desc = d; ppat_loc = symbol_rloc() }
let mkexp d =
  { pexp_desc = d; pexp_loc = symbol_rloc() }
let mkmty d =
  { pmty_desc = d; pmty_loc = symbol_rloc() }
let mksig d =
  { psig_desc = d; psig_loc = symbol_rloc() }
let mkmod d =
  { pmod_desc = d; pmod_loc = symbol_rloc() }
let mkstr d =
  { pstr_desc = d; pstr_loc = symbol_rloc() }
let mkfield d =
  { pfield_desc = d; pfield_loc = symbol_rloc() }
let mkclass d =
  { pcl_desc = d; pcl_loc = symbol_rloc() }
let mkcty d =
  { pcty_desc = d; pcty_loc = symbol_rloc() }

let reloc_pat x = { x with ppat_loc = symbol_rloc () };;
let reloc_exp x = { x with pexp_loc = symbol_rloc () };;

let mkoperator name pos =
  { pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos }

(*
  Ghost expressions and patterns:
  expressions and patterns that do not appear explicitely in the
  source file they have the loc_ghost flag set to true.
  Then the profiler will not try to instrument them and the
  -stypes option will not try to display their type.

  Every grammar rule that generates an element with a location must
  make at most one non-ghost element, the topmost one.

  How to tell whether your location must be ghost:
  A location corresponds to a range of characters in the source file.
  If the location contains a piece of code that is syntactically
  valid (according to the documentation), and corresponds to the
  AST node, then the location must be real; in all other cases,
  it must be ghost.
*)
let ghexp d = { pexp_desc = d; pexp_loc = symbol_gloc () };;
let ghpat d = { ppat_desc = d; ppat_loc = symbol_gloc () };;
let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;

let mkassert e =
  match e with
  | {pexp_desc = Pexp_construct (Lident "false", None, false) } ->
         mkexp (Pexp_assertfalse)
  | _ -> mkexp (Pexp_assert (e))
;;

let mkinfix arg1 name arg2 =
  mkexp(Pexp_apply(mkoperator name 2, ["", arg1; "", arg2]))

let neg_float_string f =
  if String.length f > 0 && f.[0] = '-'
  then String.sub f 1 (String.length f - 1)
  else "-" ^ f

let mkuminus name arg =
  match name, arg.pexp_desc with
  | "-", Pexp_constant(Const_int n) ->
      mkexp(Pexp_constant(Const_int(-n)))
  | "-", Pexp_constant(Const_int32 n) ->
      mkexp(Pexp_constant(Const_int32(Int32.neg n)))
  | "-", Pexp_constant(Const_int64 n) ->
      mkexp(Pexp_constant(Const_int64(Int64.neg n)))
  | "-", Pexp_constant(Const_nativeint n) ->
      mkexp(Pexp_constant(Const_nativeint(Nativeint.neg n)))
  | _, Pexp_constant(Const_float f) ->
      mkexp(Pexp_constant(Const_float(neg_float_string f)))
  | _ ->
      mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))

let rec mktailexp = function
    [] ->
      ghexp(Pexp_construct(Lident "[]", None, false))
  | e1 :: el ->
      let exp_el = mktailexp el in
      let l = {loc_start = e1.pexp_loc.loc_start;
               loc_end = exp_el.pexp_loc.loc_end;
               loc_ghost = true}
      in
      let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l} in
      {pexp_desc = Pexp_construct(Lident "::", Some arg, false); pexp_loc = l}

let rec mktailpat = function
    [] ->
      ghpat(Ppat_construct(Lident "[]", None, false))
  | p1 :: pl ->
      let pat_pl = mktailpat pl in
      let l = {loc_start = p1.ppat_loc.loc_start;
               loc_end = pat_pl.ppat_loc.loc_end;
               loc_ghost = true}
      in
      let arg = {ppat_desc = Ppat_tuple [p1; pat_pl]; ppat_loc = l} in
      {ppat_desc = Ppat_construct(Lident "::", Some arg, false); ppat_loc = l}

let ghstrexp e =
  { pstr_desc = Pstr_eval e; pstr_loc = {e.pexp_loc with loc_ghost = true} }

let array_function str name =
  Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))

let rec deep_mkrangepat c1 c2 =
  if c1 = c2 then ghpat(Ppat_constant(Const_char c1)) else
  ghpat(Ppat_or(ghpat(Ppat_constant(Const_char c1)),
                deep_mkrangepat (Char.chr(Char.code c1 + 1)) c2))

let rec mkrangepat c1 c2 =
  if c1 > c2 then mkrangepat c2 c1 else
  if c1 = c2 then mkpat(Ppat_constant(Const_char c1)) else
  reloc_pat (deep_mkrangepat c1 c2)

let syntax_error () =
  raise Syntaxerr.Escape_error

let unclosed opening_name opening_num closing_name closing_num =
  raise(Syntaxerr.Error(Syntaxerr.Unclosed(rhs_loc opening_num, opening_name,
                                           rhs_loc closing_num, closing_name)))

let error_msg_loc loc msg =
  raise(Syntaxerr.Error(Syntaxerr.Message (loc, msg)))
let error_msg num msg =
  error_msg_loc (rhs_loc num) msg

let bigarray_function str name =
  Ldot(Ldot(Lident "Bigarray", str), name)

let bigarray_untuplify = function
    { pexp_desc = Pexp_tuple explist} -> explist
  | exp -> [exp]

let bigarray_get arr arg =
  match bigarray_untuplify arg with
    [c1] ->
      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" "get")),
                       ["", arr; "", c1]))
  | [c1;c2] ->
      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" "get")),
                       ["", arr; "", c1; "", c2]))
  | [c1;c2;c3] ->
      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" "get")),
                       ["", arr; "", c1; "", c2; "", c3]))
  | coords ->
      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
                       ["", arr; "", ghexp(Pexp_array coords)]))

let bigarray_set arr arg newval =
  match bigarray_untuplify arg with
    [c1] ->
      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" "set")),
                       ["", arr; "", c1; "", newval]))
  | [c1;c2] ->
      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" "set")),
                       ["", arr; "", c1; "", c2; "", newval]))
  | [c1;c2;c3] ->
      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" "set")),
                       ["", arr; "", c1; "", c2; "", c3; "", newval]))
  | coords ->
      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
                       ["", arr; 
                        "", ghexp(Pexp_array coords);
                        "", newval]))

(* CDuce *)

module CD = Cduce_types
module U = CD.Encodings.Utf8

let latin1 = U.mk_latin1

let mkext d = { pext_desc = d; pext_loc = symbol_rloc() }
let mkextcst d = { pextcst_desc = d; pextcst_loc = symbol_rloc() }
let ghext d = { pext_desc = d; pext_loc = symbol_gloc () };;
let real_ghext d = { pext_desc = d; pext_loc = Location.none };;
let ghextcst d = { pextcst_desc = d; pextcst_loc = symbol_gloc () };;
let mkextexp d = { pexp_desc = Pexp_ext d; pexp_loc = symbol_rloc() }
let ghextexp d = { pexp_desc = Pexp_ext d; pexp_loc = symbol_gloc() }

let ext_pair e1 e2 =
  match e1.pexp_desc, e2.pexp_desc with
    | Pexp_ext (Pextexp_cst c1), Pexp_ext (Pextexp_cst c2) ->
	mkextexp (Pextexp_cst (mkextcst (Pextcst_pair (c1,c2))))
    | _ ->
	mkextexp (Pextexp_op ("pair",[e1;e2]))

let ext_xml e1 e2 e3 =
  match e1.pexp_desc, e2.pexp_desc, e3.pexp_desc with
    | Pexp_ext (Pextexp_cst c1), Pexp_ext (Pextexp_cst c2), 
      Pexp_ext (Pextexp_cst c3) ->
	mkextexp (Pextexp_cst (mkextcst (Pextcst_xml (c1,c2,c3))))
    | _ ->
	mkextexp (Pextexp_op ("xml",[e1;e2;e3]))

let ext_record el =
  try
    let cl = 
      List.map 
	(function (l,{ pexp_desc = Pexp_ext (Pextexp_cst c) }) -> (l,c) 
	   | _ -> raise Exit)
	el
    in
    mkextexp (Pextexp_cst (mkextcst (Pextcst_record cl)))
  with Exit ->
    mkextexp (Pextexp_record el)

let cst_nil () = ghextcst (Pextcst_intern CD.Sequence.nil_cst)

let gh_nil () = ghextexp (Pextexp_cst (cst_nil ()))

let rec ext_seq = function
  | (false,hd)::tl -> ext_pair hd (ext_seq tl)
  | (true,({ pexp_desc = 
	 Pexp_ext 
	   (Pextexp_cst 
	      { pextcst_desc = Pextcst_string (s,_); pextcst_loc = loc } 
	   )} as hd))::tl ->
      (match ext_seq tl with
	 | { pexp_desc = Pexp_ext (Pextexp_cst tl) } ->
	     mkextexp (Pextexp_cst (mkextcst (Pextcst_string (s, tl))))
	 | _ -> mkextexp(Pextexp_op ("concat",[hd;ext_seq tl])))
  | (true,hd)::tl -> mkextexp(Pextexp_op ("concat",[hd;ext_seq tl]))
  | [] -> gh_nil ()

let rec ext_tuple_pat = function
  | [hd] -> hd
  | hd::tl -> ghext (Pext_prod(hd,ext_tuple_pat tl))
  | [] -> assert false

let const_of_expr = function
  | { pexp_desc = Pexp_ext (Pextexp_cst c) } -> c
  | e -> error_msg_loc e.pexp_loc "Not a constant"


let ext_dot e l opt =
  (* e.l -->  match e with { l=# .. } | <_ l=# ..>_ -> # *)
  (* e.?l -->  match e with { l=# .. } | <_ l=# ..>_ -> [#] | _ -> [] *)
  let r = ghext(Pext_record (true, [l, (ghext(Pext_name (Lident "#")),None)])) in
  let u = ghext(Pext_cst CD.Types.any) in
  let el = ghext(Pext_xml(u,ghext(Pext_prod(r,u)))) in
  let p = ghext(Pext_or (r,el)) in
  let x = ghexp(Pexp_ident (Lident "#")) in
  let br =
    if opt then [p, ref None,
		 mkextexp (Pextexp_op ("pair",[x;gh_nil ()])); 
		 u, ref None, gh_nil ()]
    else [p, ref None, x] in
  mkextexp(Pextexp_match (e, br))

let ext_proj e =
  (* e/ --> map e with <_ _>x -> x | _ -> [] *)
  let u = real_ghext(Pext_cst CD.Types.any) in
  let p=ghext(Pext_xml(u,ghext(Pext_prod(u,ghext(Pext_name (Lident "#")))))) in
  mkextexp(Pextexp_map(e, [p,ref None,ghexp(Pexp_ident (Lident "#"));
			   u,ref None,gh_nil ()]))

let ext_filter e t =
  (* e.(t) --> match e with [ (x::t | _)* ] -> x *)
  let u = Pext_elem (ghext(Pext_cst CD.Types.any)) in
  let s = ghext(Pext_regexp 
		  (Pext_star (Pext_alt (Pext_capture ("#", Pext_elem t, Location.none), u))))
  in
  mkextexp(Pextexp_match(e, [s, ref None, ghexp(Pexp_ident (Lident "#"))]))

let check_ident s =
  let s = U.to_string s in
  let rec aux i =
    if i = String.length s then ()
    else match s.[i] with
      | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246' 
      | '\248'..'\255' | '\'' | '0'..'9' -> aux (succ i)
      | _ -> error_msg 1 "Invalid OCaml identifier"
  in
  match s.[0] with
    | 'a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' -> aux 1; s
    | _ -> error_msg 1 "Invalid OCaml identifier"

let check_uident s =
  let s = U.to_string s in
  let rec aux i =
    if i = String.length s then ()
    else match s.[i] with
      | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246' 
      | '\248'..'\255' | '\'' | '0'..'9' -> aux (succ i)
      | _ -> error_msg 1 "Invalid OCaml identifier"
  in
  match s.[0] with
    | 'A'..'Z' | '\192'..'\214' | '\216'..'\222' -> aux 1; s
    | _ -> error_msg 1 "Invalid OCaml identifier"
%}

/* Tokens */

%token AMPERAMPER
%token AMPERSAND
%token AND
%token AS
%token ASSERT
%token BACKQUOTE
%token BAR
%token BARBAR
%token BARRBRACKET
%token BEGIN
%token <char> CHAR
%token CLASS
%token COLON
%token COLONCOLON
%token COLONEQUAL
%token COLONGREATER
%token COMMA
%token CONSTRAINT
%token DO
%token DONE
%token DOT
%token DOTDOT
%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 INITIALIZER
%token <int> INT
%token <int32> INT32
%token <int64> INT64
%token <Big_int.big_int> XINT
%token <string> LABEL
%token LAZY
%token LBRACE LBRACEBRACE LBRACECOLON LBRACEBRACENAMESPACE
%token LBRACELESS
%token LBRACKET
%token LBRACKETBAR
%token LBRACKETLESS
%token LBRACKETGREATER
%token LESS
%token LESSMINUS
%token LET
%token <string> LIDENT
%token LPAREN
%token MATCH
%token METHOD
%token MINUS
%token MINUSDOT
%token MINUSGREATER
%token MINUSGREATERR
%token MODULE
%token MUTABLE
%token NAMESPACE
%token <nativeint> NATIVEINT
%token NEW
%token OBJECT
%token OF
%token OPEN
%token <string> OPTLABEL
%token OR
/* %token PARSER */
%token PLUS
%token <string> PREFIXOP
%token PRIVATE
%token QUESTION
%token QUESTIONQUESTION
%token QUOTE
%token RBRACE RCOLONBRACE RBRACEBRACE
%token RBRACKET
%token REC
%token RPAREN
%token SEMI
%token SEMISEMI
%token SHARP
%token SIG
%token STAR
%token <string> STRING
%token STRUCT
%token THEN
%token TILDE
%token TO
%token TRUE
%token TRY
%token TYPE
%token <string> UIDENT
%token UNDERSCORE
%token VAL
%token VIRTUAL
%token WHEN
%token WHILE
%token WITH

%token <Cduce_types.Encodings.Utf8.t> XSTRING2
%token <Cduce_types.Encodings.Utf8.t> XSTRING1
%token <Cduce_types.Encodings.Utf8.t> UNCNAME
%token <Cduce_types.Encodings.Utf8.t> NCNAME
%token DIV
%token MOD
%token CONCAT
%token COLONQUESTION
%token MAP
%token BANG
%token EQUALQUESTION
%token SLASH
%token STARSTAR
%token DASHDASH
%token PLUSPLUS
%token STARQUESTION
%token PLUSQUESTION

/* Precedences and associativities.

Tokens and rules have precedences.  A reduce/reduce conflict is resolved
in favor of the first rule (in source file order).  A shift/reduce conflict
is resolved by comparing the precedence and associativity of the token to
be shifted with those of the rule to be reduced.

By default, a rule has the precedence of its rightmost terminal (if any).

When there is a shift/reduce conflict between a rule and a token that
have the same precedence, it is resolved using the associativity:
if the token is left-associative, the parser will reduce; if
right-associative, the parser will shift; if non-associative,
the parser will declare a syntax error.

We will only use associativities with operators of the kind  x * x -> x
for example, in the rules of the form    expr: expr BINOP expr
in all other cases, we define two precedences if needed to resolve
conflicts.

The precedences must be listed from low to high.
*/

%nonassoc IN
%nonassoc below_SEMI
%nonassoc SEMI                          /* below EQUAL ({lbl=...; lbl=...}) */
%nonassoc LET                           /* above SEMI ( ...; let ... in ...) */
%nonassoc below_WITH
%nonassoc FUNCTION WITH                 /* below BAR  (match ... with ...) */
%nonassoc AND             /* above WITH (module rec A: SIG with ... and ...) */
%nonassoc THEN                          /* below ELSE (if ... then ...) */
%nonassoc ELSE                          /* (if ... then ... else ...) */
%nonassoc LESSMINUS                     /* below COLONEQUAL (lbl <- x := e) */
%right    COLONEQUAL                    /* expr (e := e := e) */
%nonassoc AS
%left     BAR                           /* pattern (p|p|p) */
%nonassoc below_COMMA
%left     COMMA                         /* expr/expr_comma_list (e,e,e) */
%right    MINUSGREATER                  /* core_type2 (t -> t -> t) */
%nonassoc above_MINUSGREATER
%right    OR BARBAR                     /* expr (e || e || e) */
%right    AMPERSAND AMPERAMPER          /* expr (e && e && e) */
%nonassoc below_EQUAL
%left     INFIXOP0 EQUAL LESS GREATER   /* expr (e OP e OP e) */
%right    INFIXOP1 CONCAT               /* expr (e OP e OP e) */
%right    COLONCOLON                    /* expr (e :: e :: e) */
%left     INFIXOP2 PLUS PLUSPLUS MINUS MINUSDOT  /* expr (e OP e OP e) */
%left     INFIXOP3 DIV MOD STAR         /* expr (e OP e OP e) */
%right    INFIXOP4                      /* expr (e OP e OP e) */
%nonassoc prec_unary_minus              /* unary - */
%nonassoc prec_constant_constructor     /* cf. simple_expr (C versus C x) */
%nonassoc prec_constr_appl              /* above AS BAR COLONCOLON COMMA */
%nonassoc below_SHARP
%nonassoc SHARP                         /* simple_expr/toplevel_directive */
%nonassoc below_DOT
%nonassoc DOT
/* Finally, the first tokens of simple_expr are above everything else. */
%nonassoc BACKQUOTE BEGIN CHAR FALSE FLOAT INT INT32 INT64
          LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
          NEW NATIVEINT PREFIXOP STRING TRUE UIDENT 
          LBRACEBRACE LBRACECOLON


/* 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:
    top_structure SEMISEMI               { Ptop_def $1 }
  | seq_expr SEMISEMI                    { Ptop_def[ghstrexp $1] }
  | toplevel_directive SEMISEMI          { $1 }
  | EOF                                  { raise End_of_file }
;
top_structure:
    structure_item                       { [$1] }
  | structure_item top_structure         { $1 :: $2 }
;
use_file:
    use_file_tail                        { $1 }
  | seq_expr use_file_tail               { Ptop_def[ghstrexp $1] :: $2 }
;
use_file_tail:
    EOF                                         { [] }
  | SEMISEMI EOF                                { [] }
  | SEMISEMI seq_expr use_file_tail             { Ptop_def[ghstrexp $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)) }
  | STRUCT structure error
      { unclosed "struct" 1 "end" 3 }
  | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
      { mkmod(Pmod_functor($3, $5, $8)) }
  | module_expr LPAREN module_expr RPAREN
      { mkmod(Pmod_apply($1, $3)) }
  | module_expr LPAREN module_expr error
      { unclosed "(" 2 ")" 4 }
  | LPAREN module_expr COLON module_type RPAREN
      { mkmod(Pmod_constraint($2, $4)) }
  | LPAREN module_expr COLON module_type error
      { unclosed "(" 1 ")" 5 }
  | LPAREN module_expr RPAREN
      { $2 }
  | LPAREN module_expr error
      { unclosed "(" 1 ")" 3 }
;
structure:
    structure_tail                              { $1 }
  | seq_expr structure_tail                     { ghstrexp $1 :: $2 }
;
structure_tail:
    /* empty */                                 { [] }
  | SEMISEMI                                    { [] }
  | SEMISEMI seq_expr structure_tail            { ghstrexp $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 = $3; pval_prim = $5})) }
  | TYPE type_declarations
      { mkstr(Pstr_type(List.rev $2)) }
  | EXCEPTION UIDENT constructor_arguments
      { mkstr(Pstr_exception($2, $3)) }
  | EXCEPTION UIDENT EQUAL constr_longident
      { mkstr(Pstr_exn_rebind($2, $4)) }
  | MODULE UIDENT module_binding
      { mkstr(Pstr_module($2, $3)) }
  | MODULE REC module_rec_bindings
      { mkstr(Pstr_recmodule(List.rev $3)) }
  | MODULE TYPE ident EQUAL module_type
      { mkstr(Pstr_modtype($3, $5)) }
  | OPEN mod_longident
      { mkstr(Pstr_open $2) }
  | CLASS class_declarations
      { mkstr(Pstr_class (List.rev $2)) }
  | CLASS TYPE class_type_declarations
      { mkstr(Pstr_class_type (List.rev $3)) }
  | INCLUDE module_expr
      { mkstr(Pstr_include $2) }
  | LBRACEBRACENAMESPACE ext_namespace_decl RBRACEBRACE
      { let (ns,pr) = $2 in mkstr(Pstr_namespace (ns,pr)) }
;
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_rec_bindings:
    module_rec_binding                            { [$1] }
  | module_rec_bindings AND module_rec_binding    { $3 :: $1 }
;
module_rec_binding:
    UIDENT COLON module_type EQUAL module_expr    { ($1, $3, $5) }
;

/* Module types */

module_type:
    mty_longident
      { mkmty(Pmty_ident $1) }
  | SIG signature END
      { mkmty(Pmty_signature(List.rev $2)) }
  | SIG signature error
      { unclosed "sig" 1 "end" 3 }
  | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
      %prec below_WITH
      { mkmty(Pmty_functor($3, $5, $8)) }
  | module_type WITH with_constraints
      { mkmty(Pmty_with($1, List.rev $3)) }
  | LPAREN module_type RPAREN
      { $2 }
  | LPAREN module_type error
      { unclosed "(" 1 ")" 3 }
;
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 = $3; pval_prim = []})) }
  | EXTERNAL val_ident_colon core_type EQUAL primitive_declaration
      { mksig(Psig_value($2, {pval_type = $3; pval_prim = $5})) }
  | 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 REC module_rec_declarations
      { mksig(Psig_recmodule(List.rev $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_descriptions
      { mksig(Psig_class (List.rev $2)) }
  | CLASS TYPE class_type_declarations
      { mksig(Psig_class_type (List.rev $3)) }
  | LBRACEBRACENAMESPACE ext_namespace_decl RBRACEBRACE
      { let (ns,pr) = $2 in mksig(Psig_namespace (ns,pr)) }
;

module_declaration:
    COLON module_type
      { $2 }
  | LPAREN UIDENT COLON module_type RPAREN module_declaration
      { mkmty(Pmty_functor($2, $4, $6)) }
;
module_rec_declarations:
    module_rec_declaration                              { [$1] }
  | module_rec_declarations AND module_rec_declaration  { $3 :: $1 }
;
module_rec_declaration:
    UIDENT COLON module_type                            { ($1, $3) }
;

/* Class expressions */

class_declarations:
    class_declarations AND class_declaration    { $3 :: $1 }
  | class_declaration                           { [$1] }
;
class_declaration:
    virtual_flag class_type_parameters LIDENT class_fun_binding
      { let params, variance = List.split (fst $2) in
        {pci_virt = $1; pci_params = params, snd $2;
         pci_name = $3; pci_expr = $4; pci_variance = variance;
         pci_loc = symbol_rloc ()} }
;
class_fun_binding:
    EQUAL class_expr
      { $2 }
  | COLON class_type EQUAL class_expr
      { mkclass(Pcl_constraint($4, $2)) }
  | labeled_simple_pattern class_fun_binding
      { let (l,o,p) = $1 in mkclass(Pcl_fun(l, o, p, $2)) }
;
class_type_parameters:
    /*empty*/                                   { [], symbol_gloc () }
  | LBRACKET type_parameter_list RBRACKET       { List.rev $2, symbol_rloc () }
;
class_fun_def:
    labeled_simple_pattern MINUSGREATER class_expr
      { let (l,o,p) = $1 in mkclass(Pcl_fun(l, o, p, $3)) }
  | labeled_simple_pattern class_fun_def
      { let (l,o,p) = $1 in mkclass(Pcl_fun(l, o, p, $2)) }
;
class_expr:
    class_simple_expr
      { $1 }
  | FUN class_fun_def
      { $2 }
  | class_simple_expr simple_labeled_expr_list
      { mkclass(Pcl_apply($1, List.rev $2)) }
  | LET rec_flag let_bindings IN class_expr
      { mkclass(Pcl_let ($2, List.rev $3, $5)) }
;
class_simple_expr:
    LBRACKET core_type_comma_list RBRACKET class_longident
      { mkclass(Pcl_constr($4, List.rev $2)) }
  | class_longident
      { mkclass(Pcl_constr($1, [])) }
  | OBJECT class_structure END
      { mkclass(Pcl_structure($2)) }
  | OBJECT class_structure error
      { unclosed "object" 1 "end" 3 }
  | LPAREN class_expr COLON class_type RPAREN
      { mkclass(Pcl_constraint($2, $4)) }
  | LPAREN class_expr COLON class_type error
      { unclosed "(" 1 ")" 5 }
  | LPAREN class_expr RPAREN
      { $2 }
  | LPAREN class_expr error
      { unclosed "(" 1 ")" 3 }
;
class_structure:
    class_self_pattern class_fields
      { $1, List.rev $2 }
;
class_self_pattern:
    LPAREN pattern RPAREN
      { reloc_pat $2 }
  | LPAREN pattern COLON core_type RPAREN
      { mkpat(Ppat_constraint($2, $4)) }
  | /* empty */
      { ghpat(Ppat_any) }
;
class_fields:
    /* empty */
      { [] }
  | class_fields INHERIT class_expr parent_binder
      { Pcf_inher ($3, $4) :: $1 }
  | class_fields VAL value
      { Pcf_val $3 :: $1 }
  | class_fields virtual_method
      { Pcf_virt $2 :: $1 }
  | class_fields concrete_method
      { Pcf_meth $2 :: $1 }
  | class_fields CONSTRAINT constrain
      { Pcf_cstr $3 :: $1 }
  | class_fields INITIALIZER seq_expr
      { Pcf_init $3 :: $1 }
;
parent_binder:
    AS LIDENT
          { Some $2 }
  | /* empty */
          {None}
;
value:
        mutable_flag label EQUAL seq_expr
          { $2, $1, $4, symbol_rloc () }
      | mutable_flag label type_constraint EQUAL seq_expr
          { $2, $1, (let (t, t') = $3 in ghexp(Pexp_constraint($5, t, t'))),
            symbol_rloc () }
;
virtual_method:
    METHOD PRIVATE VIRTUAL label COLON poly_type
      { $4, Private, $6, symbol_rloc () }
  | METHOD VIRTUAL private_flag label COLON poly_type
      { $4, $3, $6, symbol_rloc () }
;
concrete_method :
    METHOD private_flag label strict_binding
      { $3, $2, ghexp(Pexp_poly ($4, None)), symbol_rloc () }
  | METHOD private_flag label COLON poly_type EQUAL seq_expr
      { $3, $2, ghexp(Pexp_poly($7,Some $5)), symbol_rloc () }
  | METHOD private_flag LABEL poly_type EQUAL seq_expr
      { $3, $2, ghexp(Pexp_poly($6,Some $4)), symbol_rloc () }
;

/* Class types */

class_type:
    class_signature
      { $1 }
  | QUESTION LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
      { mkcty(Pcty_fun("?" ^ $2 ,
                       {ptyp_desc = Ptyp_constr(Lident "option", [$4]);
                        ptyp_loc = $4.ptyp_loc},
                       $6)) }
  | OPTLABEL simple_core_type_or_tuple MINUSGREATER class_type
      { mkcty(Pcty_fun("?" ^ $1 ,
                       {ptyp_desc = Ptyp_constr(Lident "option", [$2]);
                        ptyp_loc = $2.ptyp_loc},
                       $4)) }
  | LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
      { mkcty(Pcty_fun($1, $3, $5)) }
  | simple_core_type_or_tuple MINUSGREATER class_type
      { mkcty(Pcty_fun("", $1, $3)) }
;
class_signature:
    LBRACKET core_type_comma_list RBRACKET clty_longident
      { mkcty(Pcty_constr ($4, List.rev $2)) }
  | clty_longident
      { mkcty(Pcty_constr ($1, [])) }
  | OBJECT class_sig_body END
      { mkcty(Pcty_signature $2) }
  | OBJECT class_sig_body error
      { unclosed "object" 1 "end" 3 }
;
class_sig_body:
    class_self_type class_sig_fields
      { $1, List.rev $2 }
;
class_self_type:
    LPAREN core_type RPAREN
      { $2 }
  | /* empty */
      { mktyp(Ptyp_any) }
;
class_sig_fields:
    /* empty */                                 { [] }
  | class_sig_fields INHERIT class_signature    { Pctf_inher $3 :: $1 }
  | class_sig_fields VAL value_type             { Pctf_val   $3 :: $1 }
  | class_sig_fields virtual_method             { Pctf_virt  $2 :: $1 }
  | class_sig_fields method_type                { Pctf_meth  $2 :: $1 }
  | class_sig_fields CONSTRAINT constrain       { Pctf_cstr  $3 :: $1 }
;
value_type:
    mutable_flag label COLON core_type
      { $2, $1, Some $4, symbol_rloc () }
;
method_type:
    METHOD private_flag label COLON poly_type
      { $3, $2, $5, symbol_rloc () }
;
constrain:
        core_type EQUAL core_type          { $1, $3, symbol_rloc () }
;
class_descriptions:
    class_descriptions AND class_description    { $3 :: $1 }
  | class_description                           { [$1] }
;
class_description:
    virtual_flag class_type_parameters LIDENT COLON class_type
      { let params, variance = List.split (fst $2) in
        {pci_virt = $1; pci_params = params, snd $2;
         pci_name = $3; pci_expr = $5; pci_variance = variance;
         pci_loc = symbol_rloc ()} }
;
class_type_declarations:
    class_type_declarations AND class_type_declaration  { $3 :: $1 }
  | class_type_declaration                              { [$1] }
;
class_type_declaration:
    virtual_flag class_type_parameters LIDENT EQUAL class_signature
      { let params, variance = List.split (fst $2) in
        {pci_virt = $1; pci_params = params, snd $2;
         pci_name = $3; pci_expr = $5; pci_variance = variance;
         pci_loc = symbol_rloc ()} }
;

/* Core expressions */

seq_expr:
  | expr        %prec below_SEMI  { $1 }
  | expr SEMI                     { reloc_exp $1 }
  | expr SEMI seq_expr            { mkexp(Pexp_sequence($1, $3)) }
;
labeled_simple_pattern:
    QUESTION LPAREN label_let_pattern opt_default RPAREN
      { ("?" ^ fst $3, $4, snd $3) }
  | QUESTION label_var
      { ("?" ^ fst $2, None, snd $2) }
  | OPTLABEL LPAREN let_pattern opt_default RPAREN
      { ("?" ^ $1, $4, $3) }
  | OPTLABEL pattern_var
      { ("?" ^ $1, None, $2) }
  | TILDE LPAREN label_let_pattern RPAREN
      { (fst $3, None, snd $3) }
  | TILDE label_var
      { (fst $2, None, snd $2) }
  | LABEL simple_pattern
      { ($1, None, $2) }
  | simple_pattern
      { ("", None, $1) }
;
pattern_var:
    LIDENT    { mkpat(Ppat_var $1) }
;
opt_default:
    /* empty */                         { None }
  | EQUAL seq_expr                      { Some $2 }
;
label_let_pattern:
    label_var
      { $1 }
  | label_var COLON core_type
      { let (lab, pat) = $1 in (lab, mkpat(Ppat_constraint(pat, $3))) }
;
label_var:
    LIDENT    { ($1, mkpat(Ppat_var $1)) }
;
let_pattern:
    pattern
      { $1 }
  | pattern COLON core_type
      { mkpat(Ppat_constraint($1, $3)) }
;
expr:
    simple_expr %prec below_SHARP
      { $1 }
  | simple_expr simple_labeled_expr_list
      { mkexp(Pexp_apply($1, List.rev $2)) }
  | LET rec_flag let_bindings IN seq_expr
      { mkexp(Pexp_let($2, List.rev $3, $5)) }
  | LET ext_pat_delim EQUAL seq_expr IN seq_expr
      { mkextexp(Pextexp_match($4, [$2,ref None,$6])) }
  | LET MODULE UIDENT module_binding IN seq_expr
      { mkexp(Pexp_letmodule($3, $4, $6)) }
  | FUNCTION opt_bar match_cases
      { mkexp(Pexp_function("", None, List.rev $3)) }
  | FUNCTION opt_bar ext_match_cases_ml
      { 
	let m = mkextexp(Pextexp_match(ghexp(Pexp_ident (Lident "#")), 
				       List.rev $3)) in
	mkexp(Pexp_function("", None, [ ghpat(Ppat_var "#"),m ])) }
  | FUN labeled_simple_pattern fun_def
      { let (l,o,p) = $2 in mkexp(Pexp_function(l, o, [p, $3])) }
  | MATCH seq_expr WITH opt_bar match_cases
      { mkexp(Pexp_match($2, List.rev $5)) }
  | MATCH seq_expr WITH opt_bar ext_match_cases_ml
      { mkextexp(Pextexp_match($2, List.rev $5)) }
  | TRY seq_expr WITH opt_bar match_cases
      { mkexp(Pexp_try($2, List.rev $5)) }
  | TRY seq_expr WITH error
      { syntax_error() }
  | expr_comma_list %prec below_COMMA
      { mkexp(Pexp_tuple(List.rev $1)) }
  | constr_longident simple_expr %prec below_SHARP
      { mkexp(Pexp_construct($1, Some $2, false)) }
  | name_tag simple_expr %prec below_SHARP
      { mkexp(Pexp_variant($1, Some $2)) }
  | IF seq_expr THEN expr ELSE expr
      { mkexp(Pexp_ifthenelse($2, $4, Some $6)) }
  | IF seq_expr THEN expr
      { mkexp(Pexp_ifthenelse($2, $4, None)) }
  | WHILE seq_expr DO seq_expr DONE
      { mkexp(Pexp_while($2, $4)) }
  | FOR val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
      { mkexp(Pexp_for($2, $4, $6, $5, $8)) }
  | expr COLONCOLON expr
      { mkexp(Pexp_construct(Lident "::",
                             Some(ghexp(Pexp_tuple[$1;$3])),
                             false)) }
  | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN
      { mkexp(Pexp_construct(Lident "::",
                             Some(ghexp(Pexp_tuple[$5;$7])),
                             false)) }
  | 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 PLUS expr
      { mkinfix $1 "+" $3 }
  | expr MINUS expr
      { mkinfix $1 "-" $3 }
  | expr MINUSDOT expr
      { mkinfix $1 "-." $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 seq_expr RPAREN LESSMINUS expr
      { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "set")),
                         ["",$1; "",$4; "",$7])) }
  | simple_expr DOT LBRACKET seq_expr RBRACKET LESSMINUS expr
      { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "String" "set")),
                         ["",$1; "",$4; "",$7])) }
  | simple_expr DOT LBRACE expr RBRACE LESSMINUS expr
      { bigarray_set $1 $4 $7 }
  | label LESSMINUS expr
      { mkexp(Pexp_setinstvar($1, $3)) }
  | ASSERT simple_expr %prec below_SHARP
      { mkassert $2 }
  | LAZY simple_expr %prec below_SHARP
      { mkexp (Pexp_lazy ($2)) }
  | OBJECT class_structure END
      { mkexp (Pexp_object($2)) }
  | OBJECT class_structure error
      { unclosed "object" 1 "end" 3 }
;
simple_expr:
    val_longident
      { mkexp(Pexp_ident $1) }
  | constant
      { mkexp(Pexp_constant $1) }
  | constr_longident %prec prec_constant_constructor
      { mkexp(Pexp_construct($1, None, false)) }
  | name_tag %prec prec_constant_constructor
      { mkexp(Pexp_variant($1, None)) }
  | LPAREN seq_expr RPAREN
      { reloc_exp $2 }
  | LPAREN seq_expr error
      { unclosed "(" 1 ")" 3 }
  | BEGIN seq_expr END
      { reloc_exp $2 }
  | BEGIN END
      { mkexp (Pexp_construct (Lident "()", None, false)) }
  | BEGIN seq_expr error
      { unclosed "begin" 1 "end" 3 }
  | LPAREN seq_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 seq_expr RPAREN
      { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "get")),
                         ["",$1; "",$4])) }
  | simple_expr DOT LPAREN seq_expr error
      { unclosed "(" 3 ")" 5 }
  | simple_expr DOT LBRACKET seq_expr RBRACKET
      { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "String" "get")),
                         ["",$1; "",$4])) }
  | simple_expr DOT LBRACKET seq_expr error
      { unclosed "[" 3 "]" 5 }
  | simple_expr DOT LBRACE expr RBRACE
      { bigarray_get $1 $4 }
  | simple_expr DOT LBRACE expr_comma_list error
      { unclosed "{" 3 "}" 5 }
  | LBRACE record_expr RBRACE
      { let (exten, fields) = $2 in mkexp(Pexp_record(fields, exten)) }
  | LBRACE record_expr error
      { unclosed "{" 1 "}" 3 }
  | LBRACKETBAR expr_semi_list opt_semi BARRBRACKET
      { mkexp(Pexp_array(List.rev $2)) }
  | LBRACKETBAR expr_semi_list opt_semi error
      { unclosed "[|" 1 "|]" 4 }
  | LBRACKETBAR BARRBRACKET
      { mkexp(Pexp_array []) }
  | LBRACKET expr_semi_list opt_semi RBRACKET
      { reloc_exp (mktailexp (List.rev $2)) }
  | LBRACKET expr_semi_list opt_semi error
      { unclosed "[" 1 "]" 4 }
  | PREFIXOP simple_expr
      { mkexp(Pexp_apply(mkoperator $1 1, ["",$2])) }
  | NEW class_longident
      { mkexp(Pexp_new($2)) }
  | LBRACELESS field_expr_list opt_semi GREATERRBRACE
      { mkexp(Pexp_override(List.rev $2)) }
  | LBRACELESS field_expr_list opt_semi error
      { unclosed "{<" 1 ">}" 4 }
  | LBRACELESS GREATERRBRACE
      { mkexp(Pexp_override []) }
  | simple_expr SHARP label
      { mkexp(Pexp_send($1, $3)) }
  | LBRACEBRACE ext_expr RBRACEBRACE
      { $2 }
  | LBRACECOLON ext_expr RCOLONBRACE
      { mkextexp(Pextexp_to_ml $2) }
;
simple_labeled_expr_list:
    labeled_simple_expr
      { [$1] }
  | simple_labeled_expr_list labeled_simple_expr
      { $2 :: $1 }
;
labeled_simple_expr:
    simple_expr %prec below_SHARP
      { ("", $1) }
  | label_expr
      { $1 }
;
label_expr:
    LABEL simple_expr %prec below_SHARP
      { ($1, $2) }
  | TILDE label_ident
      { $2 }
  | QUESTION label_ident
      { ("?" ^ fst $2, snd $2) }
  | OPTLABEL simple_expr %prec below_SHARP
      { ("?" ^ $1, $2) }
;
label_ident:
    LIDENT   { ($1, mkexp(Pexp_ident(Lident $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 seq_expr
      { ($1, $3) }
;
fun_binding:
    strict_binding
      { $1 }
  | type_constraint EQUAL seq_expr
      { let (t, t') = $1 in ghexp(Pexp_constraint($3, t, t')) }
;
strict_binding:
    EQUAL seq_expr
      { $2 }
  | labeled_simple_pattern fun_binding
      { let (l, o, p) = $1 in ghexp(Pexp_function(l, o, [p, $2])) }
;
match_cases:
    pattern match_action                        { [$1, $2] }
  | match_cases BAR pattern match_action        { ($3, $4) :: $1 }
;
fun_def:
    match_action                                { $1 }
  | labeled_simple_pattern fun_def
      { let (l,o,p) = $1 in ghexp(Pexp_function(l, o, [p, $2])) }
;
match_action:
    MINUSGREATER seq_expr                       { $2 }
  | WHEN seq_expr MINUSGREATER seq_expr         { mkexp(Pexp_when($2, $4)) }
;
expr_comma_list:
    expr_comma_list COMMA expr                  { $3 :: $1 }
  | expr COMMA expr                             { [$3; $1] }
;
record_expr:
    simple_expr WITH lbl_expr_list opt_semi     { (Some $1, List.rev $3) }
  | lbl_expr_list opt_semi                      { (None, List.rev $1) }
;
lbl_expr_list:
    label_longident EQUAL expr
      { [$1,$3] }
  | lbl_expr_list SEMI label_longident EQUAL expr
      { ($3, $5) :: $1 }
;
field_expr_list:
    label EQUAL expr
      { [$1,$3] }
  | field_expr_list SEMI label EQUAL expr
      { ($3, $5) :: $1 }
;
expr_semi_list:
    expr                                        { [$1] }
  | expr_semi_list SEMI expr                    { $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) }
  | COLON error                                 { syntax_error() }
  | COLONGREATER error                          { syntax_error() }
;

/* Patterns */

pattern:
    simple_pattern
      { $1 }
  | pattern AS val_ident
      { mkpat(Ppat_alias($1, $3)) }
  | pattern_comma_list  %prec below_COMMA
      { mkpat(Ppat_tuple(List.rev $1)) }
  | constr_longident pattern %prec prec_constr_appl
      { mkpat(Ppat_construct($1, Some $2, false)) }
  | name_tag pattern %prec prec_constr_appl
      { mkpat(Ppat_variant($1, Some $2)) }
  | pattern COLONCOLON pattern
      { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$1;$3])),
                             false)) }
  | LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern RPAREN
      { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$5;$7])),
                             false)) }
  | pattern BAR pattern
      { mkpat(Ppat_or($1, $3)) }
;
simple_pattern:
    val_ident %prec below_EQUAL
      { 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, false)) }
  | name_tag
      { mkpat(Ppat_variant($1, None)) }
  | SHARP type_longident
      { mkpat(Ppat_type $2) }
  | LBRACE lbl_pattern_list opt_semi RBRACE
      { mkpat(Ppat_record(List.rev $2)) }
  | LBRACE lbl_pattern_list opt_semi error
      { unclosed "{" 1 "}" 4 }
  | LBRACKET pattern_semi_list opt_semi RBRACKET
      { reloc_pat (mktailpat (List.rev $2)) }
  | LBRACKET pattern_semi_list opt_semi error
      { unclosed "[" 1 "]" 4 }
  | LBRACKETBAR pattern_semi_list opt_semi BARRBRACKET
      { mkpat(Ppat_array(List.rev $2)) }
  | LBRACKETBAR BARRBRACKET
      { mkpat(Ppat_array []) }
  | LBRACKETBAR pattern_semi_list opt_semi error
      { unclosed "[|" 1 "|]" 4 }
  | LPAREN pattern RPAREN
      { reloc_pat $2 }
  | LPAREN pattern error
      { unclosed "(" 1 ")" 3 }
  | LPAREN pattern COLON core_type RPAREN
      { mkpat(Ppat_constraint($2, $4)) }
  | LPAREN pattern COLON core_type error
      { unclosed "(" 1 ")" 5 }
;

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 }
;

/* Type declarations */

type_declarations:
    type_declaration                            { [$1] }
  | type_declarations AND type_declaration      { $3 :: $1 }
;

type_declaration:
    type_parameters LIDENT type_kind constraints
      { let (params, variance) = List.split $1 in
        let (kind, manifest) = $3 in
        ($2, {ptype_params = params;
              ptype_cstrs = List.rev $4;
              ptype_kind = kind;
              ptype_manifest = manifest;
              ptype_variance = variance;
              ptype_loc = symbol_rloc()}) }
;
constraints:
        constraints CONSTRAINT constrain        { $3 :: $1 }
      | /* empty */                             { [] }
;
type_kind:
    /*empty*/
      { (Ptype_abstract, None) }
  | EQUAL core_type
      { (Ptype_abstract, Some $2) }
  | EQUAL constructor_declarations
      { (Ptype_variant(List.rev $2, Public), None) }
  | EQUAL PRIVATE constructor_declarations
      { (Ptype_variant(List.rev $3, Private), None) }
  | EQUAL private_flag BAR constructor_declarations
      { (Ptype_variant(List.rev $4, $2), None) }
  | EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
      { (Ptype_record(List.rev $4, $2), None) }
  | EQUAL core_type EQUAL private_flag opt_bar constructor_declarations
      { (Ptype_variant(List.rev $6, $4), Some $2) }
  | EQUAL core_type EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
      { (Ptype_record(List.rev $6, $4), Some $2) }
  | EQUAL PRIVATE core_type
      { (Ptype_private, Some $3) }
;
type_parameters:
    /*empty*/                                   { [] }
  | type_parameter                              { [$1] }
  | LPAREN type_parameter_list RPAREN           { List.rev $2 }
;
type_parameter:
    type_variance QUOTE ident                   { $3, $1 }
;
type_variance:
    /* empty */                                 { false, false }
  | PLUS                                        { true, false }
  | MINUS                                       { false, true }
;
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, symbol_rloc()) }
;
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 label COLON poly_type          { ($2, $1, $4, symbol_rloc()) }
;

/* "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 with_type_binder core_type constraints
      { let params, variance = List.split $2 in
        ($3, Pwith_type {ptype_params = params;
                         ptype_cstrs = List.rev $6;
                         ptype_kind = $4;
                         ptype_manifest = Some $5;
                         ptype_variance = variance;
                         ptype_loc = symbol_rloc()}) }
    /* 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) }
;
with_type_binder:
    EQUAL          { Ptype_abstract }
  | EQUAL PRIVATE  { Ptype_private }
;

/* Polymorphic types */

typevar_list:
        QUOTE ident                             { [$2] }
      | typevar_list QUOTE ident                { $3 :: $1 }
;
poly_type:
        core_type
          { mktyp(Ptyp_poly([], $1)) }
      | typevar_list DOT core_type
          { mktyp(Ptyp_poly(List.rev $1, $3)) }
;

/* Core types */

core_type:
    core_type2
      { $1 }
  | core_type2 AS QUOTE ident
      { mktyp(Ptyp_alias($1, $4)) }
;
core_type2:
    simple_core_type_or_tuple
      { $1 }
  | QUESTION LIDENT COLON core_type2 MINUSGREATER core_type2
      { mktyp(Ptyp_arrow("?" ^ $2 ,
               {ptyp_desc = Ptyp_constr(Lident "option", [$4]);
                ptyp_loc = $4.ptyp_loc}, $6)) }
  | OPTLABEL core_type2 MINUSGREATER core_type2
      { mktyp(Ptyp_arrow("?" ^ $1 ,
               {ptyp_desc = Ptyp_constr(Lident "option", [$2]);
                ptyp_loc = $2.ptyp_loc}, $4)) }
  | LIDENT COLON core_type2 MINUSGREATER core_type2
      { mktyp(Ptyp_arrow($1, $3, $5)) }
  | core_type2 MINUSGREATER core_type2
      { mktyp(Ptyp_arrow("", $1, $3)) }
;

simple_core_type:
    simple_core_type2  %prec below_SHARP
      { $1 }
  | LPAREN core_type_comma_list RPAREN %prec below_SHARP
      { match $2 with [sty] -> sty | _ -> raise Parse_error }
;
simple_core_type2:
    QUOTE ident
      { mktyp(Ptyp_var $2) }
  | UNDERSCORE
      { mktyp(Ptyp_any) }
  | type_longident
      { mktyp(Ptyp_constr($1, [])) }
  | simple_core_type2 type_longident
      { mktyp(Ptyp_constr($2, [$1])) }
  | LPAREN core_type_comma_list RPAREN type_longident
      { mktyp(Ptyp_constr($4, List.rev $2)) }
  | LESS meth_list GREATER
      { mktyp(Ptyp_object $2) }
  | LESS GREATER
      { mktyp(Ptyp_object []) }
  | SHARP class_longident opt_present
      { mktyp(Ptyp_class($2, [], $3)) }
  | simple_core_type2 SHARP class_longident opt_present
      { mktyp(Ptyp_class($3, [$1], $4)) }
  | LPAREN core_type_comma_list RPAREN SHARP class_longident opt_present
      { mktyp(Ptyp_class($5, List.rev $2, $6)) }
  | LBRACKET tag_field RBRACKET
      { mktyp(Ptyp_variant([$2], true, None)) }
/* PR#3835: this is not LR(1), would need lookahead=2
  | LBRACKET simple_core_type2 RBRACKET
      { mktyp(Ptyp_variant([$2], true, None)) }
*/
  | LBRACKET BAR row_field_list RBRACKET
      { mktyp(Ptyp_variant(List.rev $3, true, None)) }
  | LBRACKET row_field BAR row_field_list RBRACKET
      { mktyp(Ptyp_variant($2 :: List.rev $4, true, None)) }
  | LBRACKETGREATER opt_bar row_field_list RBRACKET
      { mktyp(Ptyp_variant(List.rev $3, false, None)) }
  | LBRACKETGREATER RBRACKET
      { mktyp(Ptyp_variant([], false, None)) }
  | LBRACKETLESS opt_bar row_field_list RBRACKET
      { mktyp(Ptyp_variant(List.rev $3, true, Some [])) }
  | LBRACKETLESS opt_bar row_field_list GREATER name_tag_list RBRACKET
      { mktyp(Ptyp_variant(List.rev $3, true, Some (List.rev $5))) }
  | ext_pat_delim
      { mktyp(Ptyp_ext $1) }
;
row_field_list:
    row_field                                   { [$1] }
  | row_field_list BAR row_field                { $3 :: $1 }
;
row_field:
    tag_field                                   { $1 }
  | simple_core_type2                           { Rinherit $1 }
;
tag_field:
    name_tag OF opt_ampersand amper_type_list
      { Rtag ($1, $3, List.rev $4) }
  | name_tag
      { Rtag ($1, true, []) }
;
opt_ampersand:
    AMPERSAND                                   { true }
  | /* empty */                                 { false }
;
amper_type_list:
    core_type                                   { [$1] }
  | amper_type_list AMPERSAND core_type         { $3 :: $1 }
;
opt_present:
    LBRACKETGREATER name_tag_list RBRACKET      { List.rev $2 }
  | /* empty */                                 { [] }
;
name_tag_list:
    name_tag                                    { [$1] }
  | name_tag_list name_tag                      { $2 :: $1 }
;
simple_core_type_or_tuple:
    simple_core_type                            { $1 }
  | simple_core_type STAR core_type_list
      { mktyp(Ptyp_tuple($1 :: List.rev $3)) }
;
core_type_comma_list:
    core_type                                   { [$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 opt_semi                              { [$1] }
  | DOTDOT                                      { [mkfield Pfield_var] }
;
field:
    label COLON poly_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 }
  | INT32                                       { Const_int32 $1 }
  | INT64                                       { Const_int64 $1 }
  | NATIVEINT                                   { Const_nativeint $1 }
;
signed_constant:
    constant                                    { $1 }
  | MINUS INT                                   { Const_int(- $2) }
  | MINUS FLOAT                                 { Const_float("-" ^ $2) }
  | MINUS INT32                                 { Const_int32(Int32.neg $2) }
  | MINUS INT64                                 { Const_int64(Int64.neg $2) }
  | MINUS NATIVEINT                             { Const_nativeint(Nativeint.neg $2) }
;
/* Identifiers and long identifiers */

ident:
    UIDENT                                      { $1 }
  | LIDENT                                      { $1 }
;
val_ident:
    LIDENT                                      { $1 }
  | LPAREN operator RPAREN                      { $2 }
;
val_ident_colon:
    LIDENT COLON                                { $1 }
  | LPAREN operator RPAREN COLON                { $2 }
  | LABEL                                       { $1 }
;
operator:
    PREFIXOP                                    { $1 }
  | INFIXOP0                                    { $1 }
  | INFIXOP1                                    { $1 }
  | INFIXOP2                                    { $1 }
  | INFIXOP3                                    { $1 }
  | INFIXOP4                                    { $1 }
  | PLUS                                        { "+" }
  | MINUS                                       { "-" }
  | MINUSDOT                                    { "-." }
  | STAR                                        { "*" }
  | EQUAL                                       { "=" }
  | LESS                                        { "<" }
  | GREATER                                     { ">" }
  | OR                                          { "or" }
  | BARBAR                                      { "||" }
  | AMPERSAND                                   { "&" }
  | AMPERAMPER                                  { "&&" }
  | COLONEQUAL                                  { ":=" }
;
constr_ident:
    UIDENT                                      { $1 }
/*  | LBRACKET RBRACKET                           { "[]" } */
  | LPAREN RPAREN                               { "()" }
  | COLONCOLON                                  { "::" }
/*  | LPAREN COLONCOLON RPAREN                    { "::" } */
  | FALSE                                       { "false" }
  | TRUE                                        { "true" }
;

val_longident:
    val_ident                                   { Lident $1 }
  | mod_longident DOT val_ident                 { Ldot($1, $3) }
;
constr_longident:
    mod_longident       %prec below_DOT         { $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) }
;
clty_longident:
    LIDENT                                      { Lident $1 }
  | mod_ext_longident DOT LIDENT                { 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) }
  | SHARP ident FALSE           { Ptop_dir($2, Pdir_bool false) }
  | SHARP ident TRUE            { Ptop_dir($2, Pdir_bool true) }
;

/* Miscellaneous */

name_tag:
    BACKQUOTE ident                             { $2 }
;
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 }
;
opt_bar:
    /* empty */                                 { () }
  | BAR                                         { () }
;
opt_semi:
  | /* empty */                                 { () }
  | SEMI                                        { () }
;
subtractive:
  | MINUS                                       { "-" }
  | MINUSDOT                                    { "-." }
;

/* CDuce */

ext_namespace_decl:
  | ext_lident EQUAL XSTRING2 { $1, $3 }
  | XSTRING2 { "", $1 } 
;
ext_lident:
    NCNAME { check_ident $1 }
;
ext_match_cases:
    ext_top_pat MINUSGREATER ext_expr               { [$1, ref None, $3] } 
  | ext_match_cases BAR ext_top_pat MINUSGREATER ext_expr { ($3, ref None, $5) :: $1 }
;
ext_match_cases_ml:
    ext_pat_delim MINUSGREATER seq_expr               { [$1, ref None, $3] }
  | ext_match_cases_ml BAR ext_pat_delim MINUSGREATER seq_expr 
      { ($3, ref None, $5) :: $1 } 
;
ext_pat_delim: 
    LBRACEBRACE ext_top_pat RBRACEBRACE { $2 }
ext_apply_args:
    simple_ext_expr { [ ("",$1) ] }
  | simple_ext_expr ext_apply_args { ("",$1) :: $2 }
ext_expr:
    simple_ext_expr { $1 }
  | simple_ext_expr ext_apply_args { mkexp(Pexp_apply ($1,$2)) } 
  | ext_expr PLUS ext_expr { mkextexp(Pextexp_op ("add",[$1;$3])) }
  | ext_expr PLUSPLUS ext_expr { mkextexp(Pextexp_op ("merge",[$1;$3])) }
  | ext_expr STAR ext_expr { mkextexp(Pextexp_op ("mul",[$1;$3])) }
  | ext_expr MINUS ext_expr { mkextexp(Pextexp_op ("sub",[$1;$3])) }
  | ext_expr DIV ext_expr { mkextexp(Pextexp_op ("div",[$1;$3])) }
  | ext_expr MOD ext_expr { mkextexp(Pextexp_op ("modulo",[$1;$3])) }
  | ext_expr CONCAT ext_expr {  mkextexp(Pextexp_op ("concat",[$1;$3])) }
  | LPAREN ext_expr COLONQUESTION ext_pat RPAREN
      { mkextexp(Pextexp_check ($2,$4)) } 
  | ext_expr DOT qname { ext_dot $1 $3 false }
  | ext_expr DOT QUESTION qname { ext_dot $1 $4 true }
  | simple_ext_expr SLASH { ext_proj $1 }
  | ext_expr DOT LPAREN ext_pat RPAREN { ext_filter $1 $4 }
  | ext_expr MINUSDOT qname { mkextexp(Pextexp_removefield ($1,$3)) }
  | MATCH ext_expr WITH opt_bar ext_match_cases
      { mkextexp(Pextexp_match($2, List.rev $5)) }
  | MAP ext_expr WITH opt_bar ext_match_cases
      { mkextexp(Pextexp_map($2, List.rev $5)) }
  | MAP STAR ext_expr WITH opt_bar ext_match_cases
      { mkextexp(Pextexp_xmap($3, List.rev $6)) } 
  | LET ext_top_pat EQUAL ext_expr IN ext_expr
      { mkextexp(Pextexp_match($4, [$2,ref None,$6])) }
  | LET NAMESPACE ext_namespace_decl IN ext_expr {
      let (ns,pr) = $3 in
      mkextexp(Pextexp_namespace (ns,pr,$5))
    }
/*  | simple_ext_expr LESSMINUS ext_expr { mkextexp(Pextexp_op ("apply",[$1;$3])) } */
;
simple_ext_expr:
  | LBRACEBRACE expr RBRACE RBRACE { Xparser.ext:= true; $2 }
  | LBRACECOLON expr RCOLONBRACE { mkextexp(Pextexp_from_ml $2) }
  | LESS ext_tag_expr ext_attrib_expr GREATER simple_ext_expr 
      { ext_xml $2 $3 $5 } 
  | ext_longid { mkexp (Pexp_ident $1) }
  | LBRACKET ext_expr_list RBRACKET { ext_seq $2 }
  | LPAREN ext_expr_comma_list RPAREN { 
      match (List.rev $2) with
	| hd::tl -> List.fold_left (fun accu x -> ext_pair x accu) hd tl
	| _ -> assert false
    } 
  | LBRACE ext_fields_expr RBRACE { ext_record $2 }  
  | ext_small_const { mkextexp(Pextexp_cst $1) }
;
ext_small_const:
  | ext_int  { mkextcst(Pextcst_int $1) }
  | BACKQUOTE qname { mkextcst(Pextcst_atom $2) } 
  | XSTRING1 { mkextcst(Pextcst_char $1) }
  | XSTRING2 { mkextcst(Pextcst_string ($1,cst_nil ())) }
;
ext_int:
  | ext_int_cst  { $1 }
  | LPAREN MINUS ext_int_cst RPAREN { CD.Intervals.V.negat $3 }
;
ext_int_cst:
  | XINT { CD.Intervals.V.from_bigint $1 }
;
qname:
    ext_lident COLON ncname { $1,$3 }   
  | ncname { "",$1 }
;
ncname:
    NCNAME { $1 }
  | UNCNAME { $1 }
  | MAP { U.mk "map" }
  | MATCH { U.mk "match" }
  | WITH { U.mk "with" }
  | LET { U.mk "let" }
  | IN { U.mk "in" }
  | NAMESPACE { U.mk "namespace" }
  | ELSE { U.mk "else" }
  | DIV { U.mk "div" }
  | MOD { U.mk "mod" } 
;
ext_expr_list:
    ext_expr_list_elem ext_expr_list { $1 :: $2 } 
  | /* empty */ { [] }
;
ext_expr_list_elem:
    simple_ext_expr { 
      match $1 with
	| { pexp_desc = 
	      Pexp_ext 
		(Pextexp_cst 
		   { pextcst_desc = Pextcst_char s; pextcst_loc = loc } 
		)}  ->
	    (true, mkextexp(Pextexp_cst ({ pextcst_desc = Pextcst_string (s,cst_nil ());
					   pextcst_loc = loc })))
	| e -> (false,e)
    }
  | BANG simple_ext_expr { (true,$2) }
;
ext_longid:
  | ext_lident { Lident $1 }
  | ext_modident DOT ext_lident { Ldot ($1,$3) } 
;
ext_modident:
  | UNCNAME { Lident (check_uident $1) }
  | ext_modident DOT UNCNAME { Ldot ($1, check_uident $3) } 
;
ext_expr_comma_list:
  | ext_expr { [$1] }
  | ext_expr COMMA ext_expr_comma_list { $1 :: $3 } 
;
ext_tag_expr:
    qname { mkextexp(Pextexp_cst (mkextcst(Pextcst_atom $1))) }
  | LPAREN ext_expr RPAREN { $2 } 
;
ext_fields_expr:
    qname ext_field_content opt_semi ext_fields_expr { 
      let c = match $2 with
	| Some x -> x
	| None -> ghexp(Pexp_ident (Lident (check_ident (snd $1)))) in
      ($1,c)::$4 } 
  | { [] }
;
ext_field_content:
    EQUAL simple_ext_expr { Some $2 }
  | { None } 
;
ext_attrib_expr:
    ext_fields_expr { ext_record $1 }
  | LPAREN ext_expr RPAREN { $2 } 
;


ext_top_pat:
    ext_pat { $1 }
  | ext_top_pat WITH LBRACE ext_recurs_pat_bindings RBRACE {
      mkext(Pext_recurs ($1,$4))
    }  
;  
ext_pat:
    regexp_particle { match $1 with Pext_elem x -> x 
	       | _ -> error_msg 1 "regexp not allowed here" }
  | regexp_particle BAR ext_pat { 
      match $1 with Pext_elem x ->  mkext (Pext_or (x,$3))
	| _ -> error_msg 1 "regexp not allowed here" }
;
ext_recurs_pat_bindings:
    one_recurs_pat_bindings { [$1] }
  | ext_recurs_pat_bindings AND one_recurs_pat_bindings { $3::$1 }   
;
one_recurs_pat_bindings:
    ext_lident EQUAL ext_pat { $1,$3 }
;
regexp:
    regexp_term { $1 }
  | regexp_term BAR regexp {  
      match $1,$3 with
	| Pext_elem x, Pext_elem y -> Pext_elem (mkext (Pext_or (x,y)))
	| x,y -> Pext_alt (x,y)
    } 
;
regexp_term:
    regexp_particle { $1 }
  | regexp_particle regexp_term { Pext_seq ($1,$2) }
;
regexp_particle:
    simple_regexp %prec above_MINUSGREATER { $1 }
  | simple_regexp STAR { Pext_star $1 }
  | simple_regexp STARQUESTION { Pext_weakstar $1 }
  | simple_regexp PLUS { Pext_seq ($1, Pext_star $1) }
  | simple_regexp PLUSQUESTION { Pext_seq ($1, Pext_weakstar $1) }
  | simple_regexp QUESTION { Pext_alt ($1, Pext_epsilon) }
  | simple_regexp QUESTIONQUESTION { Pext_alt (Pext_epsilon, $1) }
  | SLASH simple_regexp { 
      match $2 with
	| Pext_elem x -> Pext_guard x
	| _ -> error_msg 1 "/ is not a regexp operator" 
    }
  | simple_regexp MINUSGREATER simple_regexp {
      match $1,$3 with
	| Pext_elem x, Pext_elem y -> Pext_elem (mkext (Pext_arrow (x,y)))
	| _ -> error_msg 2 "-> is not a regexp operator"
    }  
  | regexp_particle AMPERSAND simple_regexp {
      match $1,$3 with
	| Pext_elem x, Pext_elem y -> Pext_elem (mkext (Pext_and (x,y)))
	| _ -> error_msg 2 "& is not a regexp operator"
    }
  | regexp_particle CONCAT simple_regexp {
      match $1,$3 with
	| Pext_elem x, Pext_elem y -> Pext_elem (mkext (Pext_concat (x,y)))
	| _ -> error_msg 2 "@ is not a regexp operator"
    }
  | regexp_particle PLUSPLUS simple_regexp {
      match $1,$3 with
	| Pext_elem x, Pext_elem y -> Pext_elem (mkext (Pext_merge (x,y)))
	| _ -> error_msg 2 "++ is not a regexp operator"
    }
  | regexp_particle MINUS simple_regexp {
      match $1,$3 with
	| Pext_elem x, Pext_elem y -> Pext_elem (mkext (Pext_diff (x,y)))
	| _ -> error_msg 2 "- is not a regexp operator"
    } 
;
regexp_list_elem:
  | regexp { $1 }
  | ext_lident COLONEQUAL ext_expr { 
      let c = const_of_expr $3 in
      Pext_elem (mkext(Pext_bind ($1,c))) } 
;
regexp_list:
  | regexp_list_elem COMMA regexp_list {
      match $1,$3 with
	| Pext_elem x, Pext_elem y -> Pext_elem (mkext (Pext_prod (x,y)))
	| _ -> error_msg 2 ", is not a regexp operator"
    }
  | regexp_list_elem { $1 }
;
simple_regexp:
  | ext_lident COLONCOLON simple_regexp  { Pext_capture ($1,$3,rhs_loc 1) }  
  | simple_ext_pat     { Pext_elem $1 }  
  | LPAREN regexp_list RPAREN { $2 }  
;
simple_ext_pat:
    ext_patid { mkext(Pext_name $1) }
  | UNDERSCORE { mkext(Pext_cst CD.Types.any) }
  | LESS tag_pat ext_attrib GREATER simple_regexp
    { 
      let tag = $2 in
      let attr = $3 in
      let cont = $5 in
      match cont with
	| Pext_elem cont -> mkext(Pext_xml(tag,mkext(Pext_prod(attr,cont))))
	| _ -> error_msg 5 "regexp not allowed here" 
    }
  | ext_small_const { mkext(Pext_constant ($1)) }
  | ext_int DASHDASH ext_int { 
      mkext(Pext_cst (CD.Types.interval (CD.Intervals.bounded $1 $3))) } 
  | STARSTAR DASHDASH ext_int {
      mkext(Pext_cst (CD.Types.interval (CD.Intervals.left $3))) } 
  | ext_int DASHDASH STARSTAR {
      mkext(Pext_cst (CD.Types.interval (CD.Intervals.right $1))) }
  | ext_char DASHDASH ext_char {
      mkext(Pext_cst (CD.Types.char (CD.Chars.char_class $1 $3))) }
  | LBRACE ext_fields ext_open_record RBRACE { mkext(Pext_record ($3,$2)) }
  | LBRACECOLON core_type RCOLONBRACE { mkext(Pext_from_ml $2) }
  | BACKQUOTE ext_lident COLON STAR { mkext(Pext_ns $2) }  
  | BACKQUOTE STAR { mkext(Pext_ns "") }  
  | LBRACKET regexp RBRACKET { mkext(Pext_regexp $2) }
  | LBRACKET RBRACKET { mkext(Pext_regexp Pext_epsilon) }
;
ext_id:
  | UNCNAME { check_uident $1 }  
  | ext_lident { $1 } 
;
ext_patid:
  | ext_id { Lident $1 }
  | ext_patid DOT ext_id { Ldot ($1,$3) } 
;  
tag_pat:
    LPAREN ext_pat RPAREN { $2 }
  | ext_lident COLON STAR { mkext(Pext_ns $1) }
  | qname { mkext(Pext_constant (mkextcst(Pextcst_atom $1))) } 
  | UNDERSCORE { mkext(Pext_cst CD.Types.Atom.any) }
;
ext_open_record:
    DOTDOT { true }
  | { false } 
;   
ext_fields:
    qname ext_field_pat opt_semi ext_fields { 
      let c = match $2 with
	| Some (x,e) -> (x,e)
        | None -> ghext(Pext_name (Lident (check_ident (snd $1)))), None in
     ($1,c)::$4 } 
  | { [] }
;
ext_else_clause:
    BANG ext_pat { Some $2 } 
  | { None } 
;
ext_field_pat:
    EQUAL ext_pat ext_else_clause { Some ($2,$3) }
  | EQUALQUESTION ext_pat ext_else_clause { Some (ghext(Pext_optional $2),$3) }
  | { None } 
;
ext_attrib:
    ext_fields ext_open_record { mkext(Pext_record ($2,$1)) }
  | LPAREN ext_pat RPAREN { $2 } 
;
ext_char:
    XSTRING1 { 
      let s = $1 in
      let idx = U.start_index s in
      let (i,idx) = U.next s idx in
      if not (U.equal_index idx (U.end_index s)) then
        error_msg 1 "Invalid character literal";
      CD.Chars.V.mk_int i 
    }
;
%%