/*
 JungTaek Kim

 Copyright(c) 2000-2004 KAIST/SNU Research On Program Analysis System
 (National Creative Research Initiative Center 1998-2003)
 http://ropas.snu.ac.kr/n

 All rights reserved. This file is distributed under the terms of
 an Open Source License.
*/

%{

open String_ast.Ast
open Location
open NsyntaxErr

type sub = SUB | NOTSUB

val loc = Location.symbol_rloc

val sloc = Location.rhs_loc

val nloc = Location.none

fun rloc s e = 
  let val l = sloc s 
      val l' = sloc e
   in
    Location.location_to_location
     (Location.location_field_loc_start l,
      Location.location_field_loc_end l',
      false)
  end

fun unmatched_err t s i s' i' = raise (Error(Unmatched(t,sloc i,s,sloc i',s')))

fun invalid_err t i = raise (Error(Invalid(t,sloc i)))

fun invalid_err2 t l = raise (Error(Invalid(t,l)))

fun unknown_err i = raise (Error(Unknown(sloc i)))

fun missing_err s i = raise (Error(Debug(sloc i,s)))

fun debug_err s i = raise (Error(Debug(sloc i,s)))

fun mkvarpat s i = VarPat((s,sloc i),sloc i)
fun mkconpat s i = ConPat(([],(s,sloc i),sloc i),sloc i)

fun mkconexp s i = ConExp(([],(s,sloc i),sloc i),sloc i)
fun mkvarexp s i = VarExp(([],(s,sloc i),sloc i),sloc i)

fun mktopexp l i = 
    Str(
      SimpleDec(
        ValDec([],
          [(Nonrec,VarPat(("it",nloc),nloc),SeqExp(l,sloc i),sloc i)],
          sloc i),
        sloc i),
      sloc i)

%}

/* Tokens */

%token AND
%token ANDALSO
%token AS
%token ASSIGN
%token CASE
%token DO
%token ELSE
%token END
%token EXCEPTION
%token FN
%token FOR
%token FUN
%token FUNCTOR
%token HANDLE
%token IF
%token IN
%token INCLUDE
%token LET
%token LOCAL
%token OF
%token OP
%token OPEN
%token ORELSE
%token RAISE
%token REC
%token REF
%token SIG
%token SIGNATURE
%token STRUCT
%token STRUCTURE
%token THEN
%token TYPE
%token VAL
%token WHERE
%token WHILE
%token NIL

%token <string> LID
%token <string> UID
%token <int> INT
%token <string> REAL
%token <string> STRING
%token <char> CHAR
%token <string> PATH

%token UNDERSCORE
%token LPAREN
%token RPAREN
%token LBRACE
%token RBRACE
%token COLON
%token SEMI
%token SEMISEMI
%token COMMA
%token STAR
%token ARROW
%token REVERSEARROW
%token DOUBLEARROW
%token BAR
%token LBRACKET
%token RBRACKET
%token LBRACKETBAR
%token BARRBRACKET
%token DOT
%token DOTDOTDOT
%token MINUS
%token MINUSMINUS
%token PLUS
%token PLUSPLUS
%token QUOTE
%token EQUAL
%token COLONCOLON
%token NOT
%token BANG
%token SHARP
%token EOF

%token <string> PREFIX
%token <string> INFIX0
%token <string> INFIX1
%token <string> INFIX2
%token <string> INFIX3
%token <string> INFIX4
%token <string> INFIX5

/* Precedences and associativities. Lower precedences come first. */

/* this is for error handling in pattern */
%nonassoc   prec_empty_patrow prec_empty_patcommas prec_empty_expcommas prec_empty_tyvarcommas prec_empty_strexpcommas prec_empty_fctargcommas
%right      HANDLE prec_fn prec_raise prec_case prec_match prec_fun_rule prec_val_rule
%right      SEMI prec_dec_seq prec_strdec_seq prec_dec_in_strdec prec_spec_seq prec_topdec_seq prec_strdec_in_topdec
%right      EXCEPTION FUN OPEN TYPE VAL LOCAL STRUCTURE FUNCTOR SIGNATURE INCLUDE

%right      prec_if_then 
%nonassoc   ELSE

%nonassoc   REC
%nonassoc   AND

%right      AS    /* pattern alias */
%left       COLON /* type constraint */
%left       BAR   /* or-pattern connective and alternative rules */

%right      INFIX0 ASSIGN REVERSEARROW /* assignments */
%left       ORELSE        /* or */
%left       ANDALSO       /* & */
%right      NOT
%left       INFIX1 EQUAL SHARP
%right      INFIX2
%right      COLONCOLON
%left       INFIX3 PLUS MINUS                        
%right      ARROW         /* function type connective */
%left       INFIX4 STAR   /* multiply, divide, tuple type connective */
%right      INFIX5        /* ** */ 
%nonassoc   operator_arg
%nonassoc   PATH
%left       DOT         
%nonassoc   prec_sexp
%right      PREFIX REF PLUSPLUS MINUSMINUS BANG
%nonassoc   error

/* Entry points */

%start batch_parse        /* for batch parsing (read from file) */
%type <String_ast.Ast.topdec> batch_parse
%start interactive_parse  /* for interactive parsing (read from keyboard) */
%type <String_ast.Ast.toplevel> interactive_parse

%%

varid: LID      { ($1,loc()) }

opidpat:
  | PREFIX      { ($1,loc()) } 
  | INFIX0      { ($1,loc()) }
  | INFIX1      { ($1,loc()) }
  | INFIX2      { ($1,loc()) }
  | INFIX3      { ($1,loc()) }
  | INFIX4      { ($1,loc()) }
  | INFIX5      { ($1,loc()) }
  | PLUSPLUS    { ("++",loc()) }
  | MINUSMINUS  { ("--",loc()) }
  | STAR        { ("*",loc()) }
  | EQUAL       { ("=",loc()) }
  | ANDALSO     { ("andalso",loc()) }
  | ORELSE      { ("orelse",loc()) }
  | NOT         { ("not",loc()) }
  | SHARP       { ("#",loc()) }

opid:
  | opidpat     { $1 }
  | PLUS        { ("+",loc()) }
  | MINUS       { ("-",loc()) }
  | COLONCOLON  { ("::",loc()) }
   
tyid:    
  | LID         { ($1,loc()) } 
  | REF         { ("ref",loc()) }

conid:    UID   { ($1,loc()) }
strid:    UID   { ($1,loc()) }
sigid:    UID   { ($1,loc()) }
fctid:    UID   { ($1,loc()) }

tyvar:
  | QUOTE LID   { ($2,loc()) }
  | QUOTE error { invalid_err InvTypeVar 2 }

label:
  | INT         { (string_of_int( $1 ),loc()) }
  | LID         { ($1,loc()) }

varlongid:
  | varid          { ([],$1,loc()) }
  | PATH varlongid { case $2 of (x,y,_) => (($1,sloc 1)::x,y,loc()) }

oplongid:
    PATH opid     { ([($1,sloc 1)],$2,loc()) }
  | PATH oplongid { case $2 of (x,y,_) => (($1,sloc 1)::x,y,loc()) }

tylongid:
  | tyid          { ([],$1,loc()) }
  | PATH tylongid { case $2 of (x,y,_) => (($1,sloc 1)::x,y,loc()) }
  | PATH error    { invalid_err InvTypeId 2 } ;

conlongid:
  | conid          { ([],$1,loc()) }
  | PATH conlongid { case $2 of (x,y,_) => (($1,sloc 1)::x,y,loc()) } ;

strlongid:
  | strid          { ([],$1,loc()) }
  | PATH strlongid { case $2 of (x,y,_) => (($1,sloc 1)::x,y,loc()) } ;
  | PATH error     { invalid_err InvStrId 2 } ;

sty:
  | tyvar            { VarTy($1,loc()) }
  | tylongid         { ConstTy([],$1,loc()) }
  | LPAREN error     { invalid_err InvType 2 } 
  | LPAREN ty error  { unmatched_err Unclosed "(" 1 ")" 3 } 
  | LPAREN ty RPAREN { $2 }
  | recty            { $1 }

recty:
  | LBRACE tyrow error                 { invalid_err InvLabel 3 }
  | LBRACE tyrow label error           { missing_err ":" 4 }
  | LBRACE tyrow label COLON error     { invalid_err InvType 5 }
  | LBRACE tyrow label COLON ty error  { unmatched_err Unclosed "{" 1 "}" 6 }
  | LBRACE tyrow label COLON ty RBRACE { RecordTy($2@[($3,$5,rloc 3 5)],loc()) }

tyrow:
  | /* empty */                { [] }
  | tyrow label COLON ty COMMA { $1@[($2,$4,rloc 2 4)] }

tycommas:
  | ty COMMA          { [$1] }
  | tycommas ty COMMA { $1@[$2] }

tyarg:
  | LPAREN tycommas error     { invalid_err InvType 3 }
  | LPAREN tycommas ty error  { unmatched_err Unclosed "(" 1 ")" 4 }
  | LPAREN tycommas ty RPAREN { $2@[$3] }

aty:
  | sty            { $1 }
// This error can be thought as other error like 'ty error'
//  | aty error      { invalid_err InvTypeId 2 } 
  | aty tylongid   { ConstTy([$1],$2,loc()) }
  | tyarg error    { invalid_err InvTypeId 2 }
  | tyarg tylongid { ConstTy($1,$2,loc()) }

tupty:
  | aty            { $1 }
  | ty_star error  { invalid_err InvType 3 } 
  | ty_star aty     { TupleTy($1@[$2],loc()) }

ty_star:
  | aty STAR         { [$1] }
  | ty_star aty STAR { $1@[$2] }

ty:
  | tupty            { $1 }
  | ty ARROW error { invalid_err InvType 3 } 
  | ty ARROW ty    { FunTy($1,$3,loc()) } 

spat:
  | spat_nocon { $1 }
  | conlongid  { ConPat($1,loc()) }

spat_nocon:
  | UNDERSCORE { WildPat(loc()) }
  | INT        { IntPat($1,loc()) }
  | MINUS INT  { IntPat(-$2,loc()) }
  | PLUS INT   { IntPat($2,loc()) }
  | STRING     { StringPat($1,loc()) }
  | CHAR       { CharPat($1,loc()) }
  | NIL        { ListPat([],loc()) }
  | varid      { VarPat($1,loc()) }
//  | conlongid  { ConPat($1,loc()) }
  | REF error  { invalid_err InvPat 2 }
  | REF spat   { RefPat($2,loc()) }
  | recpat     { $1 }
  | tuppat     { $1 }
  | listpat    { $1 }
  | arrpat     { $1 }

tuppat:
  | LPAREN error                { invalid_err InvPat 2 }
  | LPAREN RPAREN               { UnitPat(loc()) }
  | LPAREN opidpat error        { unmatched_err Unclosed "(" 1 ")" 3 }
  | LPAREN opidpat RPAREN       { VarPat($2,loc()) }
  | LPAREN patcommas error      { invalid_err InvPat 3 }
  | LPAREN patcommas pat error  { unmatched_err Unclosed "(" 1 ")" 4 }
  | LPAREN patcommas pat RPAREN { case $2 of
                                    [] => $3 | _ => TuplePat($2@[$3],loc()) }

listpat:
  | LBRACKET error                  { invalid_err InvPat 2 }
  | LBRACKET RBRACKET               { ListPat([],loc()) }
  | LBRACKET patcommas error        { invalid_err InvPat 3 }
  | LBRACKET patcommas pat error    { unmatched_err Unclosed "[" 1 "]" 4 }
  | LBRACKET patcommas pat RBRACKET { ListPat($2@[$3],loc()) }

arrpat:
  | LBRACKETBAR error               { invalid_err InvPat 2 }
  | LBRACKETBAR BARRBRACKET         { ArrayPat([],loc()) }
  | LBRACKETBAR patcommas error     { invalid_err InvPat 3 }
  | LBRACKETBAR patcommas pat error { unmatched_err Unclosed "[|" 1 "|]" 4 }
  | LBRACKETBAR patcommas pat BARRBRACKET { ArrayPat($2@[$3],loc()) }

patcommas:
  | /* empty */         { [] } %prec prec_empty_patcommas
  | patcommas pat COMMA { $1@[$2] }

recpat:
  | LBRACE error                        { invalid_err InvLabel 2 }
  | LBRACE RBRACE                       { RecordPat([],loc()) }
  | LBRACE patrow error                 { invalid_err InvLabel 3 }
  | LBRACE patrow LID error             { unmatched_err Unclosed "{" 1 "}" 4 }
  | LBRACE patrow LID RBRACE       
        { RecordPat($2@[(($3,sloc 3),mkvarpat $3 3,sloc 3)],loc()) }
  | LBRACE patrow DOTDOTDOT error       { unmatched_err Unclosed "{" 1 "}" 4 }
  | LBRACE patrow DOTDOTDOT RBRACE      { SubRecordPat($2,loc()) }
  | LBRACE patrow INT error             { missing_err "=" 4 }
  | LBRACE patrow label EQUAL error     { invalid_err InvPat 5 }
  | LBRACE patrow label EQUAL pat error { unmatched_err Unclosed "{" 1 "}" 6 }
  | LBRACE patrow label EQUAL pat RBRACE
        { RecordPat($2@[($3,$5,rloc 3 5)],loc()) }

patrow:
  | /* empty */                  { [] } %prec prec_empty_patrow
  | patrow LID COMMA             { $1@[(($2,sloc 2),mkvarpat $2 2,sloc 2)] } 
  | patrow label EQUAL pat COMMA { $1@[($2,$4,rloc 2,4)] } 

apat:
  | spat                 { $1 }
  | conlongid spat       { AppPat($1,$2,loc()) }
  | apat COLONCOLON error { invalid_err InvPat 3}
  | apat COLONCOLON apat    
        { AppPat(([],("::",sloc 2),sloc 2),TuplePat ([$1,$3],loc()),loc()) }
  | apat BAR error        { invalid_err InvPat 3 }
  | apat BAR apat
        { OrPat((case $1 of OrPat(l,_) => l | p => [p])
                @(case $3 of OrPat(l,_) => l | p => [p]),loc()) }

pat:
  | apat            { $1 }
  | pat COLON error { invalid_err InvType 3 }
  | pat COLON ty    { ConstraintPat($1,$3,loc()) }
  | pat AS error    { invalid_err InvPat 3 }
  | pat AS pat
        { case $1 of VarPat(v,_) => AsPat(v,None,$3,loc())
                   | ConstraintPat(VarPat(v,_),t,_) => AsPat(v,Some(t),$3,loc())
                   | _ => invalid_err InvAsPat 1 }
// This error should be caught in the greater context 
//  | error           { invalid_err InvPat 1 } 

spats:
  | /* empty */ { [] }
  | spat error  { invalid_err InvPat 2 }
  | spat spats  { $1::$2 }

firstpat:
  | apat COLONCOLON error { invalid_err InvPat 3 }
  | apat COLONCOLON apat 
        { AppPat(([],("::",sloc 2),sloc 2),TuplePat ([$1,$3],loc()),loc()) }
  | apat BAR error        { invalid_err InvPat 3 }
  | apat BAR apat
        { OrPat((case $1 of OrPat(l,_) => l | p => [p])
                @(case $3 of OrPat(l,_) => l | p => [p]),loc()) }

fnpat:
  | firstpat         { [$1] }
  | conlongid error  { invalid_err InvPat 2 }
  | conlongid spats  { (ConPat($1,loc()))::$2 }
  | spat_nocon error { invalid_err InvPat 2 }
  | spat_nocon spats { $1::$2 }

funpat:
  | spat         { [$1] }
  | funpat error { invalid_err InvPat 2 } 
  | funpat spat  { $1@[$2] } 

sexp:
  | sexp_brace   { $1 }  %prec prec_sexp
  | sexp_nobrace { $1 }  %prec prec_sexp

sexp_brace:
  | recexp                { $1 }
  | sexp_brace PLUSPLUS   { AppExp(mkvarexp "++" 2,[$1],loc()) }
  | sexp_brace MINUSMINUS { AppExp(mkvarexp "--" 2,[$1],loc()) }

sexp_nobrace:
  | INT                     { IntExp($1,loc()) }
  | REAL                    { RealExp($1,loc()) }
  | STRING                  { StringExp($1,loc()) }
  | CHAR                    { CharExp($1,loc()) }
  | NIL                     { ListExp([],loc()) }
  | varlongid               { VarExp($1,loc()) }
  | conlongid               { ConExp($1,loc()) } 
  | oplongid                { VarExp($1,loc()) }
  | sexp_nobrace PLUSPLUS   { AppExp(mkvarexp "++" 2,[$1],loc()) }
  | sexp_nobrace MINUSMINUS { AppExp(mkvarexp "--" 2,[$1],loc()) }
  | PREFIX error            { invalid_err InvExp 2 }
  | PREFIX sexp             { AppExp(mkvarexp $1 1,[$2],loc()) }
  | REF error               { invalid_err InvExp 2 }
  | REF sexp                { RefExp($2,loc()) }
  | BANG error              { invalid_err InvExp 2 }
  | BANG sexp               { DeRefExp($2,loc()) }
  | blkexp                  { $1 }
  | tupexp                  { $1 }
  | listexp                 { $1 }
  | arrexp                  { $1 }

blkexp:
  | WHILE error            { invalid_err InvExp 2 } 
  | WHILE exp error        { unmatched_err Unclosed "while" 3 "do" 5 } 
  | WHILE exp DO error     { invalid_err InvExp 4 } 
  | WHILE exp DO exp error { unmatched_err Unclosed "do" 3 "end" 5 } 
  | WHILE exp DO exp END   { WhileExp($2,$4,loc()) }
  | FOR error                                   { invalid_err InvVarId 2 } 
  | FOR varid error                             { missing_err "=" 3 } 
  | FOR varid EQUAL error                       { invalid_err InvExp 4 } 
  | FOR varid EQUAL ifexp error                 { missing_err ";" 5 } 
  | FOR varid EQUAL ifexp SEMI error            { invalid_err InvExp 6 } 
  | FOR varid EQUAL ifexp SEMI ifexp error      { missing_err ";" 7 } 
  | FOR varid EQUAL ifexp SEMI ifexp SEMI error { invalid_err InvExp 8 } 
  | FOR varid EQUAL ifexp SEMI ifexp SEMI ifexp error
        { unmatched_err Unclosed "for" 1 "do" 9 } 
  | FOR varid EQUAL ifexp SEMI ifexp SEMI ifexp DO error    
        { invalid_err InvExp 10 } 
  | FOR varid EQUAL ifexp SEMI ifexp SEMI ifexp DO exp error    
        { unmatched_err Unclosed "do" 9 "end" 11 } 
  | FOR varid EQUAL ifexp SEMI ifexp SEMI ifexp DO exp END    
        { ForExp($2,$4,$6,$8,$10,loc()) }
  | LET error               { invalid_err InvDec 2 } 
  | LET valdec error        { unmatched_err Unclosed "let" 1 "in" 3 } 
  | LET valdec IN error     { invalid_err InvExp 4 } 
  | LET valdec IN exp error { unmatched_err Unclosed "in" 3 "end" 5 } 
  | LET valdec IN exp END   { LetExp($2,$4,loc()) } 

tupexp:
  | LPAREN error                { invalid_err InvExp 2 }
  | LPAREN RPAREN               { UnitExp(loc()) }
  | LPAREN opid error           { unmatched_err Unclosed "(" 1 ")" 3 } 
  | LPAREN opid RPAREN          { VarExp(([],$2,sloc 2),loc()) }
  | LPAREN exp error            { unmatched_err Unclosed "(" 1 ")" 3 }
  | LPAREN exp RPAREN           { $2 }
  | LPAREN expcommas_comma error        { invalid_err InvExp 3 }
  | LPAREN expcommas_comma exp error    { unmatched_err Unclosed "(" 1 ")" 4 }
  | LPAREN expcommas_comma exp RPAREN   { TupleExp($2@[$3],loc()) }
//  | LPAREN expcommas error      { invalid_err InvExp 3 }
//  | LPAREN expcommas exp error  { unmatched_err Unclosed "(" 1 ")" 4 }
//  | LPAREN expcommas exp RPAREN { TupleExp($2@[$3],loc()) }

expcommas_comma:
  | exp COMMA                   { [$1] }
  | expcommas_comma exp COMMA         { $1@[$2] }

listexp:
  | LBRACKET error                  { invalid_err InvExp 2 }
  | LBRACKET RBRACKET               { ListExp([],loc()) }
  | LBRACKET expcommas error        { invalid_err InvExp 3 }
  | LBRACKET expcommas exp error    { unmatched_err Unclosed "[" 1 "]" 4 }
  | LBRACKET expcommas exp RBRACKET { ListExp($2@[$3],loc()) }

arrexp:
  | LBRACKETBAR error               { invalid_err InvExp 2 }
  | LBRACKETBAR BARRBRACKET         { ArrayExp([],loc()) }
  | LBRACKETBAR expcommas error     { invalid_err InvExp 3 }
  | LBRACKETBAR expcommas exp error { unmatched_err Unclosed "[|" 1 "|]" 4 }
  | LBRACKETBAR expcommas exp BARRBRACKET { ArrayExp($2@[$3],loc()) }

expcommas:
  | /* empty */         { [] } %prec prec_empty_expcommas
  | expcommas exp COMMA { $1@[$2] }

recexp:
  | LBRACE error                    { invalid_err InvLabel 2 }
  | LBRACE RBRACE                   { RecordExp([],loc()) }
  | LBRACE label EQUAL error        { invalid_err InvExp 4 }
  | LBRACE label EQUAL exp error    { unmatched_err Unclosed "(" 1 ")" 5 }
  | LBRACE label EQUAL exp RBRACE   { RecordExp([($2,$4,rloc 2 4)],loc()) }
  | LBRACE exprow error             { invalid_err InvLabel 3 }
  | LBRACE exprow label EQUAL error { invalid_err InvExp 5 }
  | LBRACE exprow label EQUAL exp error { unmatched_err Unclosed "(" 1 ")" 6 }
  | LBRACE exprow label EQUAL exp RBRACE
        { RecordExp($2@[($3,$5,rloc 3 5)],loc()) }

exprow:
  | label EQUAL exp COMMA        { [($1,$3,rloc 1 3)] }
  | exprow label EQUAL exp COMMA { $1@[($2,$4,rloc 2 4)] }

fldexp_nobrace:
  | sexp_nobrace                        { $1 }
  | sexp_nobrace DOT error              { invalid_err InvLabel 3 }
  | sexp_nobrace DOT label              { RecordFieldExp($1,$3,loc()) }
  | sexp_nobrace DOT LBRACKET error     { invalid_err InvExp 4 } 
  | sexp_nobrace DOT LBRACKET exp error { unmatched_err Unclosed "[" 3 "]" 5 } 
  | sexp_nobrace DOT LBRACKET exp RBRACKET { ArrayFieldExp($1,$4,loc()) }
  
fldexp_brace:
  | sexp_brace                           { $1 }
  | sexp_brace DOT error                 { invalid_err InvLabel 3 }
  | sexp_brace DOT label                 { RecordFieldExp($1,$3,loc()) }
  | sexp_brace DOT LBRACKET error        { invalid_err InvExp 4 } 
  | sexp_brace DOT LBRACKET exp error    { unmatched_err Unclosed "[" 3 "]" 5 } 
  | sexp_brace DOT LBRACKET exp RBRACKET { ArrayFieldExp($1,$4,loc()) }
  
nrecexp:
  | fldexp_nobrace { $1 }
  | fldexp_brace   { $1 }
  | nrecexp LBRACE label REVERSEARROW error { invalid_err InvExp 5 }    
  | nrecexp LBRACE label REVERSEARROW exp RBRACE    
        { SubstRecordExp($1,$3,$5,loc()) }

argexp:
  | /* empty */    { [] }
  | nrecexp argexp { $1::$2 }

aexp:
  | nrecexp argexp { case $2 of [] => $1 | _ => AppExp($1,$2,loc()) }

opexp:
  | aexp        { $1 } %prec operator_arg 
  | NOT error   { invalid_err InvExp 2 }
  | NOT opexp   { AppExp(mkvarexp "not" 1,[$2],loc()) }
  | PLUS error  { invalid_err InvExp 2 }
  | PLUS opexp  { $2 }
  | MINUS error { invalid_err InvExp 2 }
  | MINUS opexp { case $2 of IntExp(i,_) => IntExp(-i,loc())
                           | x => AppExp(mkvarexp "unary_minus" 1,[x],loc()) }
  | opexp INFIX0 error     { invalid_err InvExp 3 }
  | opexp INFIX0 opexp     { AppExp(mkvarexp $2 2,[$1,$3],loc()) }
  | opexp INFIX1 error     { invalid_err InvExp 3 }
  | opexp INFIX1 opexp     { AppExp(mkvarexp $2 2,[$1,$3],loc()) }
  | opexp INFIX2 error     { invalid_err InvExp 3 }
  | opexp INFIX2 opexp     { AppExp(mkvarexp $2 2,[$1,$3],loc()) }
  | opexp INFIX3 error     { invalid_err InvExp 3 }
  | opexp INFIX3 opexp     { AppExp(mkvarexp $2 2,[$1,$3],loc()) }
  | opexp INFIX4 error     { invalid_err InvExp 3 }
  | opexp INFIX4 opexp     { AppExp(mkvarexp $2 2,[$1,$3],loc()) }
  | opexp INFIX5 error     { invalid_err InvExp 3 }
  | opexp INFIX5 opexp     { AppExp(mkvarexp $2 2,[$1,$3],loc()) }
  | opexp SHARP error      { invalid_err InvExp 3 }
  | opexp SHARP opexp      { AppExp(mkvarexp "#" 2,[$1,$3],loc()) }
  | opexp PLUS error       { invalid_err InvExp 3 }
  | opexp PLUS opexp       { AppExp(mkvarexp "+" 2,[$1,$3],loc()) }
  | opexp MINUS error      { invalid_err InvExp 3 }
  | opexp MINUS opexp      { AppExp(mkvarexp "-" 2,[$1,$3],loc()) }
  | opexp STAR error       { invalid_err InvExp 3 }
  | opexp STAR opexp       { AppExp(mkvarexp "*" 2,[$1,$3],loc()) }
  | opexp EQUAL error      { invalid_err InvExp 3 }
  | opexp EQUAL opexp      { AppExp(mkvarexp "=" 2,[$1,$3],loc()) }
  | opexp ASSIGN error     { invalid_err InvExp 3 }
  | opexp ASSIGN opexp     { AssignExp($1,$3,loc()) }
  | opexp ANDALSO error    { invalid_err InvExp 3 }
  | opexp ANDALSO opexp    { AppExp(mkvarexp "andalso" 2,[$1,$3],loc()) }
  | opexp ORELSE error     { invalid_err InvExp 3 }
  | opexp ORELSE opexp     { AppExp(mkvarexp "orelse" 2,[$1,$3],loc()) }
  | opexp COLONCOLON error { invalid_err InvExp 3 }
  | opexp COLONCOLON opexp
        { AppExp(mkconexp "::" 2,[TupleExp([$1,$3],loc())],loc()) }
  | opexp REVERSEARROW error { invalid_err InvExp 3 }
  | opexp REVERSEARROW opexp
        { case $1 of ArrayFieldExp(a,i,_) => UpdateArrayExp(a,i,$3,loc())
                   | _ => invalid_err2 InvArrUpdate (loc()) }
typedexp:
  | opexp                { $1 }
  | typedexp COLON error { invalid_err InvType 3 }
  | typedexp COLON ty    { ConstraintExp($1,$3,loc()) }

raiseexp:
  | typedexp        { $1 }
  | RAISE error     { invalid_err InvExp 2 }
  | RAISE raiseexp  { RaiseExp($2,loc()) } %prec prec_raise

/* if you want strict application of precendence rules
   between `if' and `case', or ...,
   change `exp's to `ifexp' in `ifexp' rules. */
ifexp:
  | raiseexp          { $1 }
  | IF error          { invalid_err InvExp 2 }
  | IF exp error      { unmatched_err Unclosed "if" 1 "then" 3 }
  | IF exp THEN error { invalid_err InvExp 4 }
  | IF exp THEN exp { IfExp($2,$4,UnitExp(nloc),loc()) } %prec prec_if_then
  | IF exp THEN exp ELSE error { invalid_err InvExp 6 }
  | IF exp THEN exp ELSE exp { IfExp($2,$4,$6,loc()) }

exp:
  | ifexp                 { $1 }
  | exp SEMI error        { invalid_err InvExp 3 }
  | exp SEMI exp
        { SeqExp((case $1 of SeqExp(l,_) => l | p => [p])@
                 (case $3 of SeqExp(l,_) => l | p => [p]),loc()) }
  | exp HANDLE error      { invalid_err InvPat 3 }
  | exp HANDLE matchlist  { HandleExp($1,$3,loc()) }
  | FN error              { invalid_err InvPat 2 }
  | FN fnmatchlist        { FnExp($2,loc()) } %prec prec_fn
  | CASE error            { invalid_err InvExp 2 }
  | CASE exp error        { unmatched_err Unclosed "case" 1 "of" 3 }
  | CASE exp OF error     { invalid_err InvPat 4 }
  | CASE exp OF matchlist { CaseExp($2,$4,loc()) }    %prec prec_case

fnmatch:
// This error handled in currypat rules
//  | currypat error    { missing_err "=>" 2 }
  | fnpat DOUBLEARROW error { invalid_err InvExp 3 }
  | fnpat DOUBLEARROW exp   { ($1,$3,loc()) } %prec prec_match

fnmatchlist:
  | fnmatch                     { [$1] }
  | fnmatchlist BAR error       { invalid_err InvPat 3 }
  | fnmatchlist BAR fnmatchlist { $1@$3 } %prec prec_match

match:
  | pat error             { missing_err "=>" 2 }
  | pat DOUBLEARROW error { invalid_err InvExp 3 }
  | pat DOUBLEARROW exp   { ($1,$3,loc()) } %prec prec_match

matchlist:
  | match                   { [$1] }
  | matchlist BAR error     { invalid_err InvPat 3 }
  | matchlist BAR matchlist { $1@$3 }

valdec:
  | VAL valbinds        { ValDec([],$2,loc()) }
  | VAL tyvseq valbinds { ValDec($2,$3,loc()) }
  | FUN error           { invalid_err InvVarId 2 }
  | FUN funbinds        { FunDec([],$2,loc()) }
  | valdec valdec
        { SeqDec((case $1 of SeqDec(l,_) => l | p => [p])@
                 (case $2 of SeqDec(l,_) => l | p => [p]), loc()) }
        %prec prec_dec_seq
  | valdec SEMI error   { invalid_err InvDec 3 }
  | valdec SEMI valdec
        { SeqDec((case $1 of SeqDec(l,_) => l | p => [p])@
                 (case $3 of SeqDec(l,_) => l | p => [p]), loc()) }

dec:
  | VAL error              { invalid_err InvPat 2 }
  | VAL valbinds           { ValDec([],$2,loc()) }
  | VAL tyvseq valbinds    { ValDec($2,$3,loc()) }
  | FUN error              { invalid_err InvVarId 2 }
  | FUN funbinds           { FunDec([],$2,loc()) }
  | TYPE error             { invalid_err InvTypeId 2 }
  | TYPE typbinds          { TypeDec($2,loc()) }
  | EXCEPTION error        { invalid_err InvConId 2 }
  | EXCEPTION exnbinds     { ExceptionDec($2,loc()) }
  | OPEN error             { invalid_err InvStrId 2 }
  | OPEN strlongids        { OpenDec($2,loc()) }
  | LOCAL error            { invalid_err InvDec 2 }
  | LOCAL dec error        { unmatched_err Unclosed "local" 1 "in" 3 }
  | LOCAL dec IN error     { invalid_err InvDec 4 }
  | LOCAL dec IN dec error { unmatched_err Unclosed "in" 3 "end" 5 }
  | LOCAL dec IN dec END   { LocalDec($2,$4,loc()) }
  | dec dec
        { SeqDec((case $1 of SeqDec(l,_) => l | p => [p])@
                 (case $2 of SeqDec(l,_) => l | p => [p]), loc()) }
        %prec prec_dec_seq
  | dec SEMI error         { invalid_err InvDec 3 }
  | dec SEMI dec
        { SeqDec((case $1 of SeqDec(l,_) => l | p => [p])@
                 (case $3 of SeqDec(l,_) => l | p => [p]), loc()) }

tyvseqop:
  | /* empty */ { [] }
  | tyvseq      { $1 }

tyvseq:
  | tyvar                           { [$1] }
  | LPAREN error                    { invalid_err InvTypeVar 3 }
  | LPAREN tyvarcommas error        { invalid_err InvTypeVar 3 }
  | LPAREN tyvarcommas tyvar error  { unmatched_err Unclosed "(" 1 ")" 4 }
  | LPAREN tyvarcommas tyvar RPAREN { $2@[$3] }

tyvarcommas:
  | /* empty */             { [] } %prec prec_empty_tyvarcommas
  | tyvarcommas tyvar COMMA { $1@[$2] }

valbind:
  | pat error       { missing_err "=" 2 }
  | pat EQUAL error { invalid_err InvExp 3 }
  | pat EQUAL exp   { (Nonrec, $1,$3,loc()) }
        %prec prec_val_rule

valbinds:
  | valbind               { [$1] }
  | valbinds AND error    { invalid_err InvPat 5 }
  | valbinds AND valbinds { $1@$3 }
  | REC error             { invalid_err InvPat 2 }
  | REC valbinds          { List.map (fn (r,p,e,i) => (Rec,p,e,i)) $2 }

funrule:
  | varid error                           { invalid_err InvPat 2 }
  | varid funpat EQUAL error              { invalid_err InvExp 4 }
  | varid funpat EQUAL exp                { ($1,$2,$4,loc()) }
        %prec prec_fun_rule
  | varid funpat COLON error              { invalid_err InvType 4 }
  | varid funpat COLON ty EQUAL error     { invalid_err InvExp 6 }
  | varid funpat COLON ty EQUAL exp       { ($1,$2,ConstraintExp($6,$4,loc()),loc()) }
        %prec prec_fun_rule
  | LPAREN error                          { invalid_err InvVarId 2 }
  | LPAREN opid error                     { unmatched_err Unclosed "(" 1 ")" 3 }
  | LPAREN opid RPAREN error              { invalid_err InvPat 4 }
  | LPAREN opid RPAREN funpat EQUAL error { invalid_err InvExp 6 }
  | LPAREN opid RPAREN funpat EQUAL exp   { ($2,$4,$6,loc()) }
        %prec prec_fun_rule
  | LPAREN opid RPAREN funpat COLON error { invalid_err InvType 6 }
  | LPAREN opid RPAREN funpat COLON ty EQUAL error
                                          { invalid_err InvExp 8 }
  | LPAREN opid RPAREN funpat COLON ty EQUAL exp   
                                          { ($2,$4,ConstraintExp($8,$6,loc()),loc()) }
        %prec prec_fun_rule

funbind:
  | funrule             { [$1] }
  | funbind BAR error   { invalid_err InvVarId 3 }
  | funbind BAR funbind { $1@$3 }

funbinds:
  | funbind               { [($1,loc())] }
  | funbinds AND error    { invalid_err InvVarId 3 }
  | funbinds AND funbinds { $1@$3 }

typbind:
// This error will be handled in a larger context
//  | tyvseqop error            { invalid_err InvTypeId 2 }
  | tyvseqop tyid error          { missing_err "=" 3 }
  | tyvseqop tyid EQUAL error    { invalid_err InvType 4 }
  | tyvseqop tyid EQUAL ty       { TypeBind($1,$2,$4,loc()) }
  | tyvseqop tyid EQUAL conbinds { DataBind($1,$2,$4,loc()) }

typbinds:
  | typbind               { [$1] }
  | typbinds AND error    { invalid_err InvTypeId 3 }
  | typbinds AND typbinds { $1@$3 }

conbind:
  | conid          { ($1,None,loc()) }
  | conid OF error { invalid_err InvTypeId 3 }
  | conid OF ty    { ($1,Some($3),loc()) }

conbinds:
  | conbind               { [$1] }
  | conbinds BAR error    { invalid_err InvConId 3 }
  | conbinds BAR conbinds { $1@$3 }

exnbind:
  | conid          { ($1,None,loc()) }
  | conid OF error { invalid_err InvType 3 }
  | conid OF ty    { ($1,Some($3),loc()) }

exnbinds:
  | exnbind               { [$1] }
  | exnbinds AND error    { invalid_err InvConId 3 }
  | exnbinds AND exnbinds { $1@$3 }

strlongids:
  | strlongid            { [$1] }
  | strlongids strlongid { $1@[$2] }

strdec:
  | dec                { SimpleDec($1,loc()) } %prec prec_dec_in_strdec
  | STRUCTURE error    { invalid_err InvStrId 2 }
  | STRUCTURE strbinds { StrDec($2, loc()) }
  | strdec strdec
        { SeqStrDec((case $1 of SeqStrDec(l,_) => l | p => [p])@
                    (case $2 of SeqStrDec(l,_) => l | p => [p]),loc()) }
        %prec prec_strdec_seq
  | strdec SEMI error  { invalid_err InvStrDec 3 }
  | strdec SEMI strdec
        { SeqStrDec((case $1 of SeqStrDec(l,_) => l | p => [p])@
                    (case $3 of SeqStrDec(l,_) => l | p => [p]),loc()) }

strbind:
  | strid error                     { missing_err "=" 2 }
  | strid EQUAL error               { invalid_err InvStrExp 3 }
  | strid EQUAL strexp              { ($1,None,$3,loc()) }
  | strid COLON error               { invalid_err InvSigExp 3 }
  | strid COLON sigexp error        { missing_err "=" 4 }
  | strid COLON sigexp EQUAL error  { invalid_err InvStrExp 5 }
  | strid COLON sigexp EQUAL strexp { ($1,Some($3),$5,loc()) }

strbinds:
  | strbind               { [$1] }
  | strbinds AND error    { invalid_err InvStrId 3 }
  | strbinds AND strbinds { $1@$3 }

strexp:
  | strlongid           { VarStr($1,loc()) }
  | STRUCT error        { invalid_err InvStrDec 2 }
  | STRUCT END          { StrStr(SeqStrDec([], loc()), loc()) }
  | STRUCT strdec error { unmatched_err Unclosed "struct" 1 "end" 3 }
  | STRUCT strdec END               { StrStr($2,loc()) }
  | strexp COLON error              { invalid_err InvSigExp 3 }
  | strexp COLON sigexp             { SigStr($1,$3,loc()) }
  | fctid LPAREN error              { invalid_err InvStrExp 3 }
  | fctid LPAREN strexpcommas error { invalid_err InvStrExp 4 }
  | fctid LPAREN strexpcommas strexp error
        { unmatched_err Unclosed "(" 2 ")" 5 }
  | fctid LPAREN strexpcommas strexp RPAREN { FctAppStr($1,$3@[$4],loc()) }

strexpcommas:
  | /* empty */               { [] } %prec prec_empty_strexpcommas
  | strexpcommas strexp COMMA { $1@[$2] }

sigexp:
  | sigid           { VarSig($1,loc()) }
  | SIG error       { invalid_err InvSpec 2 }
  | SIG END         { SigSig(SeqSpec([],sloc 2),loc()) }
  | SIG spec error  { unmatched_err Unclosed "sig" 1 "end" 3 }
  | SIG spec END    { SigSig($2,loc()) }
  | sigexp whereexp { ConstraintSig($1,$2,loc()) }

spec:
  | VAL error          { invalid_err InvVarId 2 }
  | VAL valdescs       { ValSpec($2,loc()) }
  | TYPE error         { invalid_err InvTypeId 2 }
  | TYPE typdescs      { TypeSpec($2,loc()) }
  | EXCEPTION error    { invalid_err InvConId 2 }
  | EXCEPTION exndescs { ExnSpec($2,loc()) }
  | INCLUDE error      { invalid_err InvSigExp 2 }
  | INCLUDE sigexp     { IncludeSpec($2,loc()) }
  | STRUCTURE error    { invalid_err InvStrId 2 }
  | STRUCTURE strdescs { StrSpec($2,loc()) }
  | spec spec
        { SeqSpec((case $1 of SeqSpec(l,_) => l | p => [p])@
                  (case $2 of SeqSpec(l,_) => l | p => [p]),loc()) }
        %prec prec_spec_seq
  | spec SEMI spec
        { SeqSpec((case $1 of SeqSpec(l,_) => l | p => [p])@
                  (case $3 of SeqSpec(l,_) => l | p => [p]),loc()) }

valdesc:
  | varid error                    { missing_err ":" 2 }
  | varid COLON error              { invalid_err InvType 3 }
  | varid COLON ty                 { ($1,$3,loc()) }
  | LPAREN error                   { invalid_err InvVarId 2 }
  | LPAREN opid error              { unmatched_err Unclosed "(" 1 ")" 3 }
  | LPAREN opid RPAREN error       { missing_err ":" 4 }
  | LPAREN opid RPAREN COLON error { invalid_err InvType 5 }
  | LPAREN opid RPAREN COLON ty    { ($2,$5,loc()) }

valdescs:
  | valdesc               { [$1] }
  | valdescs AND error    { invalid_err InvVarId 3 }
  | valdescs AND valdescs { $1@$3 }

typdesc:
// This error will be handled in a larger context
//  | tyvseqop error             { invalid_err InvTypeId 2 }
  | tyvseqop tyid                { TypeDesc($1,$2,loc()) }
// This error will be handled in a larger context
//  | tyvseqop tyid error        { missing_err "=" 3 }
  | tyvseqop tyid EQUAL error    { invalid_err InvType 4 }
  | tyvseqop tyid EQUAL ty       { TypeBindDesc($1,$2,$4,loc()) }
  | tyvseqop tyid EQUAL condescs { DataDesc($1,$2,$4,loc()) }

typdescs:
  | typdesc               { [$1] }
  | typdescs AND error    { invalid_err InvTypeId 3 };
  | typdescs AND typdescs { $1@$3 }

condesc:
  | conid          { ($1,None,loc()) }
  | conid OF error { invalid_err InvType 3 }
  | conid OF ty    { ($1,Some($3),loc()) }

condescs:
  | condesc               { [$1] }
  | condescs BAR error    { invalid_err InvConId 3 }
  | condescs BAR condescs { $1@$3 }

exndesc:
  | conid          { ($1,None,loc()) }
  | conid OF error { invalid_err InvType 3 }
  | conid OF ty    { ($1,Some($3),loc()) }

exndescs:
  | exndesc               { [$1] }
  | exndescs AND error    { invalid_err InvConId 3 }
  | exndescs AND exndescs { $1@$3 }

strdesc:
  | strid error        { missing_err ":" 2 }
  | strid COLON error  { invalid_err InvSigExp 3 }
  | strid COLON sigexp { ($1,$3,loc()) }

strdescs:
  | strdesc               { [$1] }
  | strdescs AND error    { invalid_err InvStrId 3 }
  | strdescs AND strdescs { $1@$3 }
    
whereexp:
  | WHERE error              { missing_err "type" 2 }
  | WHERE TYPE error         { invalid_err InvTypeId 3 }
  | WHERE TYPE longtypebinds { ($3,loc()) } 

longtypebind:
  | tyvseqop tylongid EQUAL ty { ($1,$2,$4,loc()) }

longtypebinds:
  | longtypebind                    { [$1] }
  | longtypebinds AND error         { invalid_err InvTypeId 3 }
  | longtypebinds AND longtypebinds { $1@$3 }

topdec:
  | strdec             { Str($1,loc()) } %prec prec_strdec_in_topdec
  | fctdec             { Fct($1,loc()) }
  | sigdec             { Sig($1,loc()) }
  | topdec error       { invalid_err InvTopDec 2 }
  | topdec topdec
        { SeqTopDec((case $1 of SeqTopDec(l,_) => l | p => [p])@
                    (case $2 of SeqTopDec(l,_) => l | p => [p]),loc()) }
        %prec prec_topdec_seq
  | topdec SEMI error  { invalid_err InvTopDec 3 }
  | topdec SEMI topdec
        { SeqTopDec((case $1 of SeqTopDec(l,_) => l | p => [p])@
                    (case $3 of SeqTopDec(l,_) => l | p => [p]),loc()) }

fctdec:
  | FUNCTOR error                           { invalid_err InvFctId 2 }
  | FUNCTOR fctid error                     { missing_err "(" 3 }
  | FUNCTOR fctid LPAREN error              { invalid_err InvStrId 4 }
  | FUNCTOR fctid LPAREN fctargcommas error { invalid_err InvStrId 5 }
  | FUNCTOR fctid LPAREN fctargcommas fctarg error
        { unmatched_err Unclosed "(" 3 ")" 6 }
  | FUNCTOR fctid LPAREN fctargcommas fctarg RPAREN error
        { missing_err "=" 7 }
  | FUNCTOR fctid LPAREN fctargcommas fctarg RPAREN EQUAL error
        { invalid_err InvStrExp 8 }
  | FUNCTOR fctid LPAREN fctargcommas fctarg RPAREN EQUAL strexp
        { ($2,$4@[$5],None,$8,loc()) }
  | FUNCTOR fctid LPAREN fctargcommas fctarg RPAREN COLON error
        { invalid_err InvSigExp 8 }
  | FUNCTOR fctid LPAREN fctargcommas fctarg RPAREN COLON sigexp error
        { missing_err "=" 9 }
  | FUNCTOR fctid LPAREN fctargcommas fctarg RPAREN COLON sigexp EQUAL error
        { invalid_err InvStrExp 10 }
  | FUNCTOR fctid LPAREN fctargcommas fctarg RPAREN COLON sigexp EQUAL strexp
        { ($2,$4@[$5],Some($8),$10,loc()) }

fctarg:
  | strid error        { missing_err ":" 2 }
  | strid COLON error  { invalid_err InvSigExp 3 }
  | strid COLON sigexp { ($1,$3,loc()) }

fctargcommas:
  | /* empty */               { [] } %prec prec_empty_fctargcommas
  | fctargcommas fctarg COMMA { $1@[$2] }

sigdec:
  | SIGNATURE error    { invalid_err InvSigId 2 }
  | SIGNATURE sigbinds { ($2,loc()) }

sigbind:
  | sigid error        { missing_err "=" 2 }
  | sigid EQUAL error  { invalid_err InvSigExp 3 }
  | sigid EQUAL sigexp { ($1,$3,loc()) }

sigbinds:
  | sigbind               { [$1] }
  | sigbinds AND error    { invalid_err InvSigId 3 }
  | sigbinds AND sigbinds { $1@$3 }

/***** poisson *****/

/* Entry points */

batch_parse:
  | error      { invalid_err InvTopDec 1 }
  | topdec EOF { $1 }

interactive_parse:
  | error                        { invalid_err InvTopDec 1 }
  | topdec SEMISEMI              { TopDec($1,loc()) }
  | exp SEMISEMI                 { TopExp($1,loc()) }
  | SHARP error                  { invalid_err InvTopDir 2}
  | SHARP LID error              { invalid_err InvTopDir 3 }
  | SHARP LID SEMISEMI           { TopDir($2, NoneArg,loc()) }
  | SHARP LID STRING error       { missing_err ";;" 4 }
  | SHARP LID STRING SEMISEMI    { TopDir($2, StringArg ($3),loc()) }
  | SHARP LID INT error          { missing_err ";;" 4 }
  | SHARP LID INT SEMISEMI       { TopDir($2, IntArg ($3),loc()) }
  | SHARP LID varlongid error    { missing_err ";;" 4 }
  | SHARP LID varlongid SEMISEMI { TopDir($2, LidentArg ($3),loc()) }
  | EOF                          { raise End_of_file }

%%

(*
 Modification history.

 2000/03/27 By Judaigi

 - Create typbind and typdesc rules.
 - Change typbinds and typdescs rules according to typbind and typdesc rules.
 - Change according to changes in ast.
*)