%{ (* -*- caml -*- *)
  open Types
  open Common
  open Parser_helper

  let parse_error msg = die_rule msg
  let prog_ref = ref None
  let to_String e = Parser_helper.to_String (some !prog_ref) e
  let from_PATTERN e = Parser_helper.from_PATTERN (some !prog_ref) e
  let from_PATTERN_SUBST e = Parser_helper.from_PATTERN_SUBST (some !prog_ref) e
%}


%token <unit   Types.any_spaces_pos> EOF
%token <string Types.any_spaces_pos> NUM RAW_STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PO_COMMENT PERL_CHECKER_COMMENT ONE_SCALAR_PARA
%token <(string * string) Types.any_spaces_pos> PRINT_TO_STAR PRINT_TO_SCALAR
%token <string Types.any_spaces_pos> QUOTEWORDS COMPACT_HASH_SUBSCRIPT
%token <(string * Types.raw_pos) Types.any_spaces_pos> RAW_HERE_DOC
%token <(string * ((int * int) * token) list) list Types.any_spaces_pos> STRING COMMAND_STRING
%token <((string * ((int * int) * token) list) list * Types.raw_pos) Types.any_spaces_pos> HERE_DOC

%token <((string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN QR_PATTERN
%token <((string * ((int * int) * token) list) list * (string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN_SUBST

%token <(string option * string) Types.any_spaces_pos> SCALAR_IDENT ARRAY_IDENT HASH_IDENT FUNC_IDENT STAR_IDENT RAW_IDENT RAW_IDENT_PAREN ARRAYLEN_IDENT
%token <string Types.any_spaces_pos> SUB_WITH_PROTO
%token <(string option * string * string) Types.any_spaces_pos> FUNC_DECL_WITH_PROTO

%token <string Types.any_spaces_pos> FOR PRINT
%token <unit   Types.any_spaces_pos> NEW FORMAT
%token <string Types.any_spaces_pos> COMPARE_OP COMPARE_OP_STR EQ_OP EQ_OP_STR
%token <string Types.any_spaces_pos> ASSIGN MY_OUR

%token <unit   Types.any_spaces_pos> IF ELSIF ELSE UNLESS DO WHILE UNTIL CONTINUE SUB LOCAL
%token <unit   Types.any_spaces_pos> USE PACKAGE BEGIN END
%token <unit   Types.any_spaces_pos> AT DOLLAR PERCENT AMPERSAND STAR ARRAYLEN
%token <unit   Types.any_spaces_pos> SEMI_COLON PKG_SCOPE
%token <unit   Types.any_spaces_pos> PAREN PAREN_END
%token <unit   Types.any_spaces_pos> BRACKET BRACKET_END BRACKET_HASHREF
%token <unit   Types.any_spaces_pos> ARRAYREF ARRAYREF_END

%token <unit   Types.any_spaces_pos> ARROW
%token <unit   Types.any_spaces_pos> INCR DECR
%token <unit   Types.any_spaces_pos> POWER
%token <unit   Types.any_spaces_pos> TIGHT_NOT BIT_NEG REF
%token <unit   Types.any_spaces_pos> PATTERN_MATCH PATTERN_MATCH_NOT
%token <string Types.any_spaces_pos> MULT
%token <string Types.any_spaces_pos> PLUS
%token <string Types.any_spaces_pos> BIT_SHIFT
%token <unit   Types.any_spaces_pos> LT GT CONCAT MULT_L_STR
%token <unit   Types.any_spaces_pos> BIT_AND
%token <unit   Types.any_spaces_pos> BIT_OR BIT_XOR
%token <unit   Types.any_spaces_pos> AND_TIGHT
%token <unit   Types.any_spaces_pos> OR_TIGHT
%token <string Types.any_spaces_pos> DOTDOT
%token <unit   Types.any_spaces_pos> QUESTION_MARK COLON
%token <unit   Types.any_spaces_pos> COMMA RIGHT_ARROW
%token <unit   Types.any_spaces_pos> NOT
%token <unit   Types.any_spaces_pos> AND
%token <unit   Types.any_spaces_pos> OR XOR

%nonassoc PREC_LOW
%nonassoc LOOPEX

%right      OR XOR
%right      AND
%right      NOT
%nonassoc   LSTOP
%left   COMMA RIGHT_ARROW

%right      ASSIGN
%right      QUESTION_MARK COLON
%nonassoc   DOTDOT
%left       OR_TIGHT
%left       AND_TIGHT
%left       BIT_OR BIT_XOR
%left       BIT_AND
%nonassoc   EQ_OP EQ_OP_STR
%nonassoc   LT GT COMPARE_OP COMPARE_OP_STR
%nonassoc   UNIOP
%left       BIT_SHIFT
%left       PLUS CONCAT
%left       MULT MULT_L_STR
%left       PATTERN_MATCH PATTERN_MATCH_NOT
%right      TIGHT_NOT BIT_NEG REF UNARY_MINUS
%right      POWER
%nonassoc   INCR DECR
%left       ARROW

%nonassoc PAREN_END
%left PAREN PREC_HIGH
%left ARRAYREF BRACKET

%type <Types.fromparser list> prog
%type <prio_expr_spaces_pos> expr term
%type <fromparser any_spaces_pos> scalar bracket_subscript variable restricted_subscripted

%start prog


%%
prog: lines EOF {$1.any}

lines: /* A collection of "lines" in the program */
| { default_esp [] }
| sideff { new_1esp [$1.any] $1 }
| line lines { if $2.any <> [] then mcontext_check_none "value is dropped" $1.any $1; new_esp $2.mcontext ($1.any @ $2.any) $1 $2 }

line:
| decl { new_1esp [$1.any] $1 }
| if_then_else { new_1esp [$1.any] $1 }
| loop { new_1esp [$1.any] $1 }
| LABEL { sp_cr($1); new_1esp [Label $1.any] $1 }
| PERL_CHECKER_COMMENT {sp_p($1); new_1esp [Perl_checker_comment($1.any, get_pos $1)] $1 }
| semi_colon {new_1esp [Semi_colon] $1 }
| sideff semi_colon {new_1esp [$1.any ; Semi_colon] $1 }
| BRACKET lines BRACKET_END            {check_block_sub $2 $3; new_esp $2.mcontext [Block $2.any] $1 $3}
| BRACKET lines BRACKET_END semi_colon {check_block_sub $2 $3; new_esp $2.mcontext [Block $2.any] $1 $4}

if_then_else: /* Real conditional expressions */
| IF     PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; to_Call_op (if $9.any = [] then M_none else mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8 @ [$9.mcontext])) "if"     (prio_lo P_loose $3 :: Block $6.any :: $8.any @ $9.any) $1 $9}
| UNLESS PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; check_unless_else $8 $9; to_Call_op M_none "unless" (prio_lo P_loose $3 :: Block $6.any :: $8.any @ $9.any) $1 $9}

elsif:
|  {default_esp []}
| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; new_esp (mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8)) (prio_lo P_loose $3 :: Block $6.any :: $8.any) $1 $8}

else_: 
|            { default_esp [] }
| ELSE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_sub $3 $4; new_esp $3.mcontext [Block $3.any] $1 $4}

loop:
| WHILE PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; to_Call_op M_none "while" [ prio_lo P_loose $3; Block $6.any ] $1 $8}
| UNTIL PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; to_Call_op M_none "until" [ prio_lo P_loose $3; Block $6.any ] $1 $8}
| FOR PAREN expr_or_empty semi_colon expr_or_empty semi_colon expr_or_empty PAREN_END BRACKET lines BRACKET_END {sp_p($1); check_for($1); sp_n($2); sp_0($3); sp_p($5); sp_p($7); sp_0($8); sp_n($9); check_block_sub $10 $11; to_Call_op M_none "for" [ $3.any; $5.any; $7.any; Block $10.any ] $1 $11}
| FOR SCALAR_IDENT PAREN expr PAREN_END BRACKET lines BRACKET_END cont { die_rule "don't use for without \"my\"ing the iteration variable" }
| FOR PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_list $3; check_block_sub $6 $7; check_for_foreach $1 $3; to_Call_op M_none "foreach" [ prio_lo P_loose $3; Block $6.any ] $1 $8}
| for_my lines BRACKET_END cont {check_block_sub $2 $3; to_Call_op M_none "foreach my" ($1.any @ [ Block $2.any ]) $1 $4}

for_my:
| FOR MY_OUR SCALAR_IDENT PAREN expr PAREN_END BRACKET {sp_p($1); check_my($2); check_foreach($1); sp_n($4); sp_0($5); sp_0_or_cr($6); sp_p($7); new_esp M_none [ My_our($2.any, [I_scalar, snd $3.any], get_pos $3); prio_lo P_loose $5 ] $1 $7}


cont: /* Continue blocks */
|  {default_esp ()}
| CONTINUE BRACKET lines BRACKE