(*****************************************************************************)
(* (C) 2006 Benjamin <BookeldOr> Canou                                       *)
(*          Philippe <Sparkles> Wang                                         *)
(*                      __  _______     _       ___                          *)
(*                     |__||______ \_  | \     / __|                         *)
(*            __ _ _    \ \/ /| | \__|  \ \   / /| |     _ _ __              *)
(*             _\_\_\____\__/_|_|__|_|__|\_\_/_/||_|____/_/_/_               *)
(*            __/_/_/    /  \ | |  |_|  | \ | / || |    \_\_\__              *)
(*                      /_/\_\|_|_/ _|  | |\_/| ||_|__                       *)
(*                     |__||_______/    |_|   |_||____|                      *)
(*                                                                           *)
(*               eXtensible Designed Multiparadigm Language                  *)
(*                                                                           *)
(* This program is free software; you can redistribute it and/or             *)
(* modify it under the terms of the GNU General Public                       *)
(* License as published by the Free Software Foundation; either              *)
(* version 2 of the License, or (at your option) any later version.          *)
(*                                                                           *)
(* This program is distributed in the hope that it will be useful,           *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU         *)
(* General Public License for more details.                                  *)
(*                                                                           *)
(* You should have received a copy of the GNU General Public                 *)
(* License along with this program; if not, write to the                     *)
(* Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,              *)
(* Boston, MA  02110-1301, USA.                                              *)
(*                                                                           *)
(*****************************************************************************)

(* $Id: parser.mly,v 1.1 2006/09/30 21:50:49 phil Exp $ *)


%{
open Ast
open Lexing2

let mk_code_location ls le = {
    location_file_name = ls.name;
    location_start_line = ls.lin;
    location_start_column = ls.col;
    location_end_line = le.lin;
    location_end_column = le.col;
  }

let mk_ast_description ast ls le = {
    ast = ast;
    ast_code_location = {
	location_file_name = ls.name;
	location_start_line = ls.lin;
	location_start_column = ls.col;
	location_end_line = le.lin;
	location_end_column = le.col;
      };
    ast_comment = None;
  }

let mk_asti_description asti ls le = {
    asti = asti;
    asti_code_location = {
	location_file_name = ls.name;
	location_start_line = ls.lin;
	location_start_column = ls.col;
	location_end_line = le.lin;
	location_end_column = le.col;
      };
    asti_comment = None;
  }


let mk_ast_description_expression exp ls le = {
    expression = exp;
    expression_type = Ast_type_unknown;
    expression_location = {
	location_file_name = ls.name;
	location_start_line = ls.lin;
	location_start_column = ls.col;
	location_end_line = le.lin;
	location_end_column = le.col;
      };
  }

let mk_ast_description_pattern pats ls le = {
    patterns = pats;
    patterns_as = [];
    pattern_type = Ast_type_unknown;
    pattern_location = {
	location_file_name = ls.name;
	location_start_line = ls.lin;
	location_start_column = ls.col;
	location_end_line = le.lin;
	location_end_column = le.col;
      };
  }

let mk_ast_type_record_field name is_mutable typ =
  { field_name = name;
    field_mutable = is_mutable ;
    field_type = typ ;  }

let rec mk_list ls startpos endpos =
  match ls with
    | [] ->
        mk_ast_description_expression
          (Ast_expression_constructor
            (Ident.cons "Pervasives" "Nil",None))
          startpos endpos
    | hd::tl ->
	mk_ast_description_expression
	  (Ast_expression_constructor
	      (Ident.cons "Pervasives" "Cons",
	      Some
		(mk_ast_description_expression
		    (Ast_expression_tuple [hd;mk_list tl startpos endpos])
		    startpos endpos)))
	  startpos endpos

let rec mk_pat_list ls startpos endpos =
  match ls with
    | [] ->
        mk_ast_description_pattern
          [Ast_pattern_constructor
            (Ident.cons "Pervasives" "Nil",None)]
          startpos endpos
    | hd::tl ->
	mk_ast_description_pattern
	  [Ast_pattern_constructor
	      (Ident.cons "Pervasives" "Cons",
	      Some
		(mk_ast_description_pattern
		    [Ast_pattern_tuple [hd;mk_pat_list tl startpos endpos]]
		    startpos endpos)) ]
	  startpos endpos

let fake_unit = {
    expression = Ast_expression_constant Ast_constant_unit;
    expression_type = Ast_type_unknown;
    expression_location = {
	location_file_name = "";
	location_start_line = -1;
	location_start_column = -1;
	location_end_line = -1;
	location_end_column = -1;
      };
  }

let parse_error ls le msg =
  Messages.error
    { location_file_name = ls.name;
      location_start_line = ls.lin;
      location_start_column = ls.col;
      location_end_line = le.lin;
      location_end_column = le.col; }
    (match msg with
       | Some msg -> ("Parse error: "^msg)
       | None -> "Parse error")

let parse_error_unclosed a _ ls le =
  parse_error
    ls le
    ( Some ("This \""^a^"\" remains unmatched"))
    
%}

/* Tokens */
%token ABSTRACT
%token AMPERAMPER
%token AMPERSAND
%token AND
%token AS
%token BAR
%token BARBAR
%token BARRBRACKET
%token BEGIN
%token <char> CHAR
%token COLON
%token COLONCOLON
%token COLONEQUAL
%token COMMA
%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 <float> FLOAT
%token FOR
%token FUN
%token FUNCTION
%token GREATER
%token IF
%token IN
%token <string> INFIXOP0
%token <string> INFIXOP1
%token <string> INFIXOP2
%token <string> INFIXOP3
%token <string> INFIXOP4
%token <int> INT
%token <string> LABEL
%token LBRACE
%token LBRACKET
%token LBRACKETBAR
%token LESS
%token LESSMINUS
%token LET
%token <string> LIDENT
%token LPAREN
%token MATCH
%token MINUS
%token MINUSDOT
%token MINUSGREATER
%token MOD
%token MUTABLE
%token OF
%token OPEN
%token OR
/* %token PARSER */
%token PLUS
%token <string> PREFIXOP
%token PRIVATE
%token QUOTE
%token RBRACE
%token RBRACKET
%token REC
%token RPAREN
%token SEMI
%token SEMISEMI
%token STAR
%token <string> STRING
%token THEN
%token TO
%token TRUE
%token TRY
%token TYPE
%token <string> UIDENT
%token UNDERSCORE
%token VAL
%token WHEN
%token WHILE
%token WITH

%nonassoc below_SEMI
%nonassoc SEMI                          /* below EQUAL ({lbl=...; lbl=...}) */
%nonassoc LET                           /* above SEMI ( ...; let ... in ...) */
%nonassoc FUNCTION WITH                 /* below BAR  (match ... with ...) */
%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_type (t -> t -> t) */
%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                      /* expr (e OP e OP e) */
%right    COLONCOLON                    /* expr (e :: e :: e) */
%left     INFIXOP2 PLUS MINUS MINUSDOT  /* expr (e OP e OP e) */
%left     INFIXOP3 STAR MOD             /* 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_DOT
%nonassoc DOT
/* Finally, the first tokens of simple_expr are above everything else. */
%nonassoc BEGIN CHAR FALSE FLOAT INT
          LBRACE LBRACKET LBRACKETBAR LIDENT LPAREN
          PREFIXOP STRING TRUE UIDENT


/* Entry points */

%start program
%type <Ast.program> program
%start interface
%type <Ast.interface> interface

%%

/* Entry points */

program:
    structure EOF                        { $1 }
;
interface:
    signature EOF                        { List.rev $1 }
;

/* Module expressions */

structure:
    structure_tail                              { $1 }
  | seq_expr structure_tail
      { (mk_ast_description (Ast_expression $1) $startpos $endpos) :: $2 }
;
structure_tail:
    /* empty */                                 { [] }
  | SEMISEMI                                    { [] }
  | SEMISEMI seq_expr structure_tail
      { (mk_ast_description (Ast_expression $2) $startpos $endpos) :: $3 }
  | SEMISEMI structure_item structure_tail      { $2 :: $3 }
  | structure_item structure_tail               { $1 :: $2 }
  | error     { parse_error $startpos $endpos None}
;
structure_item:
  | PRIVATE LET rec_flag let_bindings
      { mk_ast_description
	  (Ast_value_definition
	      ({declaration_recursive = $3;
		declaration_list = $4;
		declaration_code_location =
		  mk_code_location $startpos $endpos;},
	      Ast_visibility_private))
	  $startpos $endpos }
  | LET rec_flag let_bindings
      { mk_ast_description
	  (Ast_value_definition
	      ({declaration_recursive = $2;
		declaration_list = $3;
		declaration_code_location =
		  mk_code_location $startpos $endpos;},
	      Ast_visibility_public))
	  $startpos $endpos }
  | EXTERNAL cn = val_ident COLON t = core_type EQUAL n = STRING
      { mk_ast_description
	  (Ast_external_value (cn,n,t,Ast_visibility_public))
	  $startpos $endpos }
  | TYPE separated_nonempty_list(AND,type_declaration)
      { mk_ast_description
	  (Ast_type_definition $2) $startpos $endpos }
  | EXCEPTION UIDENT constructor_arguments
      { mk_ast_description
	  (Ast_exception_definition ($2,$3))
	  $startpos $endpos }
  | OPEN UIDENT
      { mk_ast_description
	  (Ast_open_module $2)
	  $startpos $endpos }
;

signature:
    /* empty */                                 { [] }
  | signature signature_item                    { $2 :: $1 }
  | signature signature_item SEMISEMI           { $2 :: $1 }
;
signature_item:
    VAL val_ident_colon core_type
      { mk_asti_description
	  (Asti_value($2, $3)) $startpos $endpos }
  | TYPE separated_nonempty_list(AND,type_declaration)
      { mk_asti_description
	  (Asti_type $2) $startpos $endpos }
  | EXCEPTION UIDENT constructor_arguments
      { mk_asti_description
	  (Asti_exception($2, $3)) $startpos $endpos }
;


/* Core expressions */

seq_expr:
  | expr        %prec below_SEMI
      { $1 }
  | expr SEMI
      { { $1 with expression_location =
	  mk_code_location $startpos $endpos } }
  | expr SEMI seq_expr
      { mk_ast_description_expression
	  (Ast_expression_sequence ($1,$3))
	  $startpos $endpos }
;
expr:
  | simple_expr
      { $1 }
  | simple_expr nonempty_list(simple_expr)
      {	List.fold_left
	  (fun ls e ->
	    mk_ast_description_expression
	      (Ast_expression_application (ls,e))
	      $startpos $endpos)
	  $1
	  $2 }
  | LET rec_flag let_bindings IN seq_expr
      { mk_ast_description_expression
	  (Ast_expression_local_declaration
	      ({declaration_recursive = $2;
		declaration_list = $3;
		declaration_code_location =
		  mk_code_location $startpos $endpos;},
	      $5))
	  $startpos $endpos }
  | FUNCTION option(BAR) cases = match_cases
      { mk_ast_description_expression
	  (Ast_expression_function cases)
	  $startpos $endpos }
  | FUN ls = nonempty_list(simple_pattern)
    MINUSGREATER e = seq_expr
      { List.fold_right
	  (fun p e ->
	    mk_ast_description_expression
	      (Ast_expression_function [p,None,e])
	      $startpos $endpos) ls e }
  | FUN ls = nonempty_list(simple_pattern)
    WHEN w = seq_expr MINUSGREATER e = seq_expr
      { mk_ast_description_expression
	  (Ast_expression_function
	      [List.hd ls,Some w,
	      List.fold_right
		(fun p e ->
		  mk_ast_description_expression
		    (Ast_expression_function [p,None,e])
		    $startpos $endpos)
		(List.tl ls) e])
	  $startpos $endpos }
  | MATCH e = seq_expr WITH option(BAR) cases = match_cases
      { mk_ast_description_expression
	  (Ast_expression_pattern_matching (e,cases))
	  $startpos $endpos }
  | TRY e = seq_expr WITH option(BAR) cases = match_cases
      { mk_ast_description_expression
	  (Ast_expression_try (e,cases))
	  $startpos $endpos }
  | ls = expr_comma_list %prec below_COMMA
      { mk_ast_description_expression
	  (Ast_expression_tuple (List.rev ls))
	  $startpos $endpos }
  | cons = constr_longident ; exp = simple_expr
      { mk_ast_description_expression
	  (Ast_expression_constructor (cons,Some exp))
	  $startpos $endpos }
  | IF seq_expr THEN expr ELSE expr
      { mk_ast_description_expression
	  (Ast_expression_alternative ($2,$4,$6))
	  $startpos $endpos }
  | IF seq_expr THEN expr
      { mk_ast_description_expression
	  (Ast_expression_alternative ($2,$4,fake_unit))
	  $startpos $endpos }
  | WHILE seq_expr DO seq_expr DONE
      { mk_ast_description_expression
	  (Ast_expression_while_loop ($2,$4))
	  $startpos $endpos }
  | FOR LIDENT EQUAL seq_expr TO seq_expr DO seq_expr DONE
      { mk_ast_description_expression
	  (Ast_expression_for_loop ($2,$4,$6,$8))
	  $startpos $endpos }
  | FOR LIDENT EQUAL seq_expr DOWNTO seq_expr DO seq_expr DONE
      { mk_ast_description_expression
	  (Ast_expression_for_downto_loop ($2,$4,$6,$8))
	  $startpos $endpos }
  | hd = expr COLONCOLON tl = expr
      { mk_ast_description_expression
          (Ast_expression_constructor
              (Ident.cons "Pervasives" "Cons",
              Some
                  (mk_ast_description_expression
                      (Ast_expression_tuple [hd;tl])
                      $startpos $endpos)))
          $startpos $endpos }
  | LPAREN COLONCOLON RPAREN LPAREN hd = expr COMMA tl = expr RPAREN
      { mk_ast_description_expression
          (Ast_expression_constructor
              (Ident.cons "Pervasives" "Cons",
              Some
                  (mk_ast_description_expression
                      (Ast_expression_tuple [hd;tl])
                      $startpos(hd) $endpos(tl))))
          $startpos $endpos }
  | e1 = expr ; op = INFIXOP0 ; e2 = expr
  | e1 = expr ; op = INFIXOP1 ; e2 = expr
  | e1 = expr ; op = INFIXOP2 ; e2 = expr
  | e1 = expr ; op = INFIXOP3 ; e2 = expr
  | e1 = expr ; op = INFIXOP4 ; e2 = expr
  { mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value (Ident.orphan_cons op))
		      $startpos(op) $endpos(op),e1))
	      $startpos(e1) $endpos(op),e2))
      $startpos $endpos }
  | e1 = expr ; PLUS       ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "+"  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; MINUS      ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "-"  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }

  | e1 = expr ; MINUSDOT   ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "-."  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; MOD       ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "mod"  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; STAR       ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "*"  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; EQUAL      ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "="  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; LESS       ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "<"  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; GREATER    ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons ">" ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; OR         ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "or" ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; BARBAR     ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "||"  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; AMPERSAND  ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "&"  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; AMPERAMPER ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons "&&"  ))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }
  | e1 = expr ; COLONEQUAL ; e2 = expr
  {
    mk_ast_description_expression
      (Ast_expression_application
	  (mk_ast_description_expression
	      (Ast_expression_application
		  ( mk_ast_description_expression
		      (Ast_expression_value
			  (Ident.orphan_cons ":="))
		      $startpos($2) $endpos($2),
		  e1))
	      $startpos(e1) $endpos($2),
	  e2))
      $startpos $endpos }

   | e1 = subtractive e2 = expr %prec prec_unary_minus
       { mk_ast_description_expression
	   (Ast_expression_application
	       (mk_ast_description_expression
		   (Ast_expression_application
		       ( mk_ast_description_expression
			   (Ast_expression_value (Ident.orphan_cons "-."))
			   $startpos(e1) $endpos(e1),
		       ( mk_ast_description_expression
			   (Ast_expression_constant (Ast_constant_float 0.))
			   $startpos $endpos
		       )))
		   $startpos $endpos,e2))
	   $startpos $endpos }
   | simple_expr DOT label_longident LESSMINUS expr
       { mk_ast_description_expression
	   (Ast_expression_assignment
	       (mk_ast_description_expression
		   (Ast_expression_record_access ($1, $3))
		   $startpos $endpos,
 	       $5))
 	   $startpos $endpos }

  | e = simple_expr DOT LPAREN i = seq_expr RPAREN LESSMINUS v = expr
      { mk_ast_description_expression
	  (Ast_expression_application (
	      ( mk_ast_description_expression
		  (Ast_expression_application (
		      ( mk_ast_description_expression
			  (Ast_expression_application (
			      (mk_ast_description_expression
				  (Ast_expression_value
				      (Ident.cons "Pervasives" "array_set"))
				  $startpos $endpos),e))
			  $startpos $endpos ),i))
		  $startpos $endpos ),v))
	  $startpos $endpos }
  | e = simple_expr DOT LBRACKET i = seq_expr RBRACKET LESSMINUS v = expr
      { mk_ast_description_expression
	  (Ast_expression_application (
	      ( mk_ast_description_expression
		  (Ast_expression_application (
		      ( mk_ast_description_expression
			  (Ast_expression_application (
			      (mk_ast_description_expression
				  (Ast_expression_value
				      (Ident.cons "Pervasives" "string_set"))
				  $startpos $endpos ),e))
			  $startpos $endpos ),i))
		  $startpos $endpos ),v))
	  $startpos $endpos }
;
simple_expr:
  | val_longident
      { mk_ast_description_expression
	  (Ast_expression_value $1)
	  $startpos $endpos }
  | constant
      { mk_ast_description_expression
	  (Ast_expression_constant $1)
	  $startpos $endpos }
  | FALSE
      { mk_ast_description_expression
	  (Ast_expression_constant (Ast_constant_boolean false))
	  $startpos $endpos }
  | TRUE
      { mk_ast_description_expression
	  (Ast_expression_constant (Ast_constant_boolean true))
	  $startpos $endpos }
  | LPAREN RPAREN
      { mk_ast_description_expression
	  (Ast_expression_constant Ast_constant_unit)
	  $startpos $endpos }
  | cons = constr_longident %prec prec_constant_constructor
      { mk_ast_description_expression
	  (Ast_expression_constructor (cons,None))
	  $startpos $endpos }
  | LPAREN seq_expr RPAREN
      { { $2 with expression_location =
	  mk_code_location $startpos $endpos } }
  | b = LPAREN seq_expr error
      { parse_error_unclosed "(" ")" $startpos(b) $endpos(b) }
  | BEGIN seq_expr END
      { { $2 with expression_location =
	  mk_code_location $startpos $endpos } }
  | BEGIN END
      { fake_unit }
  | b = BEGIN seq_expr error
      { parse_error_unclosed "begin" "end" $startpos(b) $endpos(b) }
  | LPAREN e = seq_expr t = type_constraint RPAREN
      { { e with expression_type = Ast_type_constraint t } }
  | e = simple_expr DOT f = label_longident
      { mk_ast_description_expression
	  (Ast_expression_record_access (e,f))
	  $startpos $endpos }
  | e = simple_expr DOT LPAREN i = seq_expr RPAREN
      { mk_ast_description_expression
	  (Ast_expression_application (
	      ( mk_ast_description_expression
		  (Ast_expression_application (
		      (mk_ast_description_expression
			  (Ast_expression_value
			      (Ident.cons "Pervasives" "array_get"))
		          $startpos $endpos),e))
		  $startpos $endpos ),i))
	  $startpos $endpos }
  | simple_expr DOT b = LPAREN seq_expr error
      { parse_error_unclosed "(" ")" $startpos(b) $endpos(b) }
  | e = simple_expr DOT LBRACKET i = seq_expr RBRACKET
      { mk_ast_description_expression
	  (Ast_expression_application (
	      ( mk_ast_description_expression
		  (Ast_expression_application (
		      (mk_ast_description_expression
			  (Ast_expression_value
			      (Ident.cons "Pervasives" "string_get"))
			  $startpos $endpos ),e))
		  $startpos $endpos ),i))
	  $startpos $endpos }
  | simple_expr DOT b = LBRACKET seq_expr error
      { parse_error_unclosed "[" "]" $startpos(b) $endpos(b) }
  | rc = block(LBRACE,SEMI,RBRACE,separated_pair(label_longident,EQUAL,expr))
      { mk_ast_description_expression
	  (Ast_expression_record (None,rc))
	  $startpos $endpos }
  | LBRACE ; v = simple_expr ;
    rc = block(WITH,SEMI,RBRACE,separated_pair(label_longident,EQUAL,expr))
      { mk_ast_description_expression
	  (Ast_expression_record (Some v,rc))
	  $startpos $endpos }
  | ar = block(LBRACKETBAR,SEMI,BARRBRACKET,expr)
      { mk_ast_description_expression
	  (Ast_expression_array ar)
	  $startpos $endpos }
  | LBRACKETBAR BARRBRACKET
      { mk_ast_description_expression
	  (Ast_expression_array [])
	  $startpos $endpos }
  | ls = block(LBRACKET,SEMI,RBRACKET,expr)
      { mk_list ls $startpos $endpos }
  | op = PREFIXOP ; e = simple_expr
      { mk_ast_description_expression
	  (Ast_expression_application (
	      (mk_ast_description_expression
		  (Ast_expression_value
		      (Ident.orphan_cons op))
		  $startpos $endpos ),e))
	  $startpos $endpos }
;
let_bindings:
  | let_binding                                 { [$1] }
  | let_bindings AND let_binding                { $1@[$3] }
;
let_binding:
  | id = val_ident ; e = fun_binding
      { mk_ast_description_pattern
	  [Ast_pattern_name id]
	  $startpos $endpos,e }
  | p = pattern EQUAL e = seq_expr
      { (p,e) }
;
fun_binding:
  | e = strict_binding
      { e }
  | c = type_constraint EQUAL e = seq_expr
      { { e with expression_type = Ast_type_constraint c } }
;
strict_binding:
  | EQUAL e = seq_expr
      { e }
  | p = simple_pattern ; e = fun_binding
      { mk_ast_description_expression
	  (Ast_expression_function [p,None,e])
	  $startpos $endpos }
;
match_cases:
  | p = pattern MINUSGREATER e = seq_expr
      { [p,None,e] }
  | p = pattern WHEN w = seq_expr MINUSGREATER e = seq_expr
      { [p,Some w,e] }
  | ls = match_cases BAR p = pattern MINUSGREATER e = seq_expr
      { ls@[p,None,e] }
  | ls = match_cases BAR p = pattern WHEN w = seq_expr MINUSGREATER e = seq_expr
      { ls@[p,Some w,e] }
;

expr_comma_list:
    expr_comma_list COMMA expr                  { $3 :: $1 }
  | expr COMMA expr                             { [$3; $1] }
;

type_constraint:
    COLON core_type
      { { constraint_type = $2 ;
          constraint_location =
          mk_code_location $startpos $endpos;
      } }
;

/* Patterns */

pattern:
  | simple_pattern
      { $1 }
  | p = pattern AS id = val_ident
      { { p with patterns_as = p.patterns_as@[id]} }
  | ls = pattern_comma_list  %prec below_COMMA
      { mk_ast_description_pattern
	  [Ast_pattern_tuple (List.rev ls)]
	  $startpos $endpos }
  | cons = constr_longident ; v = pattern %prec prec_constr_appl
      { mk_ast_description_pattern
	  [Ast_pattern_constructor (cons,Some v)]
	  $startpos $endpos }
  | hd = pattern COLONCOLON tl = pattern
  | LPAREN COLONCOLON RPAREN LPAREN hd = pattern COMMA tl = pattern RPAREN
      { mk_ast_description_pattern
	  [Ast_pattern_constructor
	      (Ident.cons "Pervasives" "Cons",
	      Some
		  (mk_ast_description_pattern
		      [Ast_pattern_tuple [hd;tl]]
		      $startpos $endpos)) ]
	  $startpos $endpos }
  | p1 = pattern BAR p2 = pattern
      { mk_ast_description_pattern
	  (p1.patterns@p2.patterns)
	  $startpos $endpos }
;
simple_pattern:
  | id = val_ident %prec below_EQUAL
      { mk_ast_description_pattern
	  [Ast_pattern_name id]
	  $startpos $endpos }
  | UNDERSCORE
      { mk_ast_description_pattern
	  [Ast_pattern_any]
	  $startpos $endpos }
  | c = signed_constant
      { mk_ast_description_pattern
	  [Ast_pattern_constant c]
	  $startpos $endpos }
  | a = CHAR DOTDOT z = CHAR
      { let rec mki min max f =
	  if min <= max then (f min)::(mki (min + 1) max f) else []
	in
	  mk_ast_description_pattern
	    (mki
		(Char.code a)
		(Char.code z)
		(fun x ->
		  Ast_pattern_constant (Ast_constant_character (Char.chr x))))
	    $startpos $endpos }
  | FALSE
      { mk_ast_description_pattern
	  [Ast_pattern_constant (Ast_constant_boolean false)]
	  $startpos $endpos }
  | TRUE
      { mk_ast_description_pattern
	  [Ast_pattern_constant (Ast_constant_boolean true)]
	  $startpos $endpos }
  | LPAREN RPAREN
      { mk_ast_description_pattern
	  [Ast_pattern_constant Ast_constant_unit]
	  $startpos $endpos }
  | cons = constr_longident
      { mk_ast_description_pattern
	  [Ast_pattern_constructor (cons,None)]
	  $startpos $endpos }
  | rc = block(LBRACE,SEMI,RBRACE,separated_pair(label_longident,EQUAL,pattern))
      { mk_ast_description_pattern
	  [Ast_pattern_record rc]
	  $startpos $endpos }
  | ls = block(LBRACKET,SEMI,RBRACKET,pattern)
      {  mk_pat_list ls $startpos $endpos }
  | ar = block(LBRACKETBAR,SEMI,BARRBRACKET,pattern)
      { mk_ast_description_pattern
	  [Ast_pattern_array ar]
	  $startpos $endpos }
  | LBRACKETBAR BARRBRACKET
      { mk_ast_description_pattern
	  [Ast_pattern_array []]
	  $startpos $endpos }
  | LPAREN pat = pattern RPAREN
      { { pat with pattern_location = mk_code_location $startpos $endpos } }
  | LPAREN pat = pattern ; t = type_constraint ; RPAREN
      { { pat with pattern_type = Ast_type_constraint t } }
;

pattern_comma_list:
    pattern_comma_list COMMA pattern            { $3 :: $1 }
  | pattern COMMA pattern                       { [$3; $1] }
;

/* Type declarations */

type_declaration:
  | p = type_parameters; n = LIDENT; EQUAL; t = type_kind
      {{ type_name = n ;
         type_parameters = p;
         type_value = Some t;
         type_code_location = mk_code_location $startpos $endpos;
        },
        Ast_visibility_public }
  | p = type_parameters; n = LIDENT; EQUAL ABSTRACT; t = option(type_kind)
      {{ type_name = n ;
         type_parameters = p;
         type_value = t;
         type_code_location = mk_code_location $startpos $endpos;
        },
        Ast_visibility_abstract }
  | p = type_parameters; n = LIDENT
      {{ type_name = n ;
         type_parameters = p;
         type_value = None;
         type_code_location = mk_code_location $startpos $endpos;
        },
        Ast_visibility_abstract }
  | p = type_parameters;n = LIDENT EQUAL PRIVATE;t = option(type_kind)
      {{ type_name = n ;
         type_parameters = p;
         type_value = t;
         type_code_location = mk_code_location $startpos $endpos;
        },
        Ast_visibility_private }
  | p = type_parameters;n = LIDENT EQUAL PRIVATE ABSTRACT
      {{ type_name = n ;
         type_parameters = p;
         type_value = None;
         type_code_location = mk_code_location $startpos $endpos;
        },
        Ast_visibility_private }

type_kind:
  | t = core_type
      { Ast_type_terminal t }
  | d = constructor_declarations
      { Ast_type_sum (List.rev d) }
  | BAR; d = constructor_declarations
      { Ast_type_sum (List.rev d) }
  | LBRACE; rc = label_declarations option(SEMI) ;RBRACE
      { Ast_type_record(List.rev rc) }
;
type_parameters:
    /*empty*/                                   { [] }
  | type_parameter                              { [$1] }
  | LPAREN type_parameter_list RPAREN           { List.rev $2 }
;
type_parameter:
    /*type_variance*/ QUOTE ident                  /* { $3, $1 } */
                                      { "'"^$2  }
;
/*
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) }
;
constructor_arguments:
    /*empty*/                                   { None }
  | OF core_type                                { Some $2 }
;
label_declarations:
    label_declaration                           { [$1] }
  | label_declarations SEMI label_declaration   { $3 :: $1 }
;
label_declaration:
    mutable_flag label COLON core_type
           { mk_ast_type_record_field $2 $1 $4 }
;


/* Core types */

core_type:
    simple_core_type_or_tuple
      { $1 }
  | core_type MINUSGREATER core_type
      { Ast_type_arrow($1, $3) }
;

simple_core_type:
  | t = simple_core_type2
      { t }
  | LPAREN t = core_type_comma_list RPAREN
      { match t with [e] -> e | _ -> raise Error }
;
simple_core_type2: /* : ast_type_terminal */
    QUOTE ident
      { Ast_type_type(Ident.orphan_cons ("'" ^ $2), []) }
/*  | UNDERSCORE
      { mktyp(Ptyp_any) } */
  | type_longident
      { Ast_type_type ($1, []) }
  | simple_core_type2 type_longident
      { Ast_type_type ($2, [$1]) }
  | LPAREN core_type_comma_list RPAREN type_longident
      { Ast_type_type ($4, List.rev $2) }
;

simple_core_type_or_tuple:
    simple_core_type                            { $1 }
  | simple_core_type STAR core_type_list
      { let l = $1 :: List.rev $3 in
	  Ast_type_tuple (List.length l, l) }
;
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 }
;

label:
    LIDENT                                      { $1 }
;

/* Constants */

constant:
  | INT                                         { Ast_constant_integer $1 }
  | CHAR                                        { Ast_constant_character $1 }
  | STRING                                      { Ast_constant_string $1 }
  | FLOAT                                       { Ast_constant_float $1 }
;
signed_constant:
  | constant                                    { $1 }
  | MINUS INT                                   { Ast_constant_integer (- $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                                      { "||" }
  | MOD                                         { "mod" }
  | AMPERSAND                                   { "&" }
  | AMPERAMPER                                  { "&&" }
  | COLONEQUAL                                  { ":=" }
;
constr_ident:
    UIDENT                                      { $1 }
  | LPAREN RPAREN                               { "()" }
  | COLONCOLON                                  { "::" }
  | FALSE                                       { "false" }
  | TRUE                                        { "true" }
;

val_longident:
  | val_ident                                   { Ident.orphan_cons $1 }
  | UIDENT DOT val_ident                        { Ident.cons $1 $3 }
;
constr_longident:
  | UIDENT %prec below_DOT                      { Ident.orphan_cons $1 }
  | UIDENT DOT UIDENT                           { Ident.cons $1 $3 }
  | LBRACKET RBRACKET                           { Ident.cons "Pervasives" "Nil" }
;
label_longident:
  | LIDENT                                      { Ident.orphan_cons $1 }
  | UIDENT DOT LIDENT                           { Ident.cons $1 $3 }
;
type_longident:
  | LIDENT                                      { Ident.orphan_cons $1 }
  | UIDENT DOT LIDENT                           { Ident.cons $1 $3 }
;

/* Miscellaneous */

rec_flag:
  | /* empty */                                 { false }
  | REC                                         { true }
;
mutable_flag:
    /* empty */                                 { false }
  | MUTABLE                                     { true }
;

subtractive:
  | MINUS                                       { "-" }
  | MINUSDOT                                    { "-." }
;
%public block_aux(separator,ender,X):
  | x = X ; ender
  | x = X ; separator ; ender
  { [ x ] }
  | x = X; separator; xs = block_aux(separator,ender,X)
  { x :: xs }

%public block(starter,separator,ender,X):
  | starter ; c = block_aux(separator,ender,X)
  { c }

%%