diff options
| author | Pascal Rigaux <pixel@mandriva.com> | 2003-04-15 20:00:07 +0000 | 
|---|---|---|
| committer | Pascal Rigaux <pixel@mandriva.com> | 2003-04-15 20:00:07 +0000 | 
| commit | 3e23d94c2ebcb964d19dcaa3d0b7829c7f44c52e (patch) | |
| tree | bfe8b300037455502f56a449a4fd56c2349e74f5 /perl_checker.src | |
| parent | 0d8b42a489c296210edf39a8890e28779b823b7c (diff) | |
| download | perl_checker-3e23d94c2ebcb964d19dcaa3d0b7829c7f44c52e.tar perl_checker-3e23d94c2ebcb964d19dcaa3d0b7829c7f44c52e.tar.gz perl_checker-3e23d94c2ebcb964d19dcaa3d0b7829c7f44c52e.tar.bz2 perl_checker-3e23d94c2ebcb964d19dcaa3d0b7829c7f44c52e.tar.xz perl_checker-3e23d94c2ebcb964d19dcaa3d0b7829c7f44c52e.zip  | |
add basic "type" checking (using a very liberal lattice)
Diffstat (limited to 'perl_checker.src')
| -rw-r--r-- | perl_checker.src/lexer.mll | 229 | ||||
| -rw-r--r-- | perl_checker.src/parser.mly | 427 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.ml | 164 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.mli | 37 | ||||
| -rw-r--r-- | perl_checker.src/types.mli | 15 | 
5 files changed, 529 insertions, 343 deletions
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index 47e0f7a..59e348e 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -10,7 +10,8 @@ type raw_token =    | EOF of raw_pos    | SPACE of int    | CR -  | NUM of (string * raw_pos) +  | INT of (string * raw_pos) +  | FLOAT of (string * raw_pos)    | RAW_STRING of (string * raw_pos)    | STRING of (raw_interpolated_string * raw_pos)    | PATTERN of (raw_interpolated_string * string * raw_pos) @@ -45,15 +46,15 @@ type raw_token =    | NEW of (raw_pos) | FORMAT of (raw_pos) | AT of raw_pos | DOLLAR of raw_pos | PERCENT of raw_pos | AMPERSAND of raw_pos    | STAR of raw_pos | ARRAYLEN of raw_pos | SEMI_COLON of raw_pos | PKG_SCOPE of raw_pos | PAREN of raw_pos | PAREN_END of raw_pos | BRACKET of raw_pos    | BRACKET_END of raw_pos | BRACKET_HASHREF of raw_pos | ARRAYREF of raw_pos | ARRAYREF_END of raw_pos | ARROW of raw_pos | INCR of raw_pos | DECR of raw_pos -  | POWER of raw_pos | TIGHT_NOT of raw_pos | BIT_NEG of raw_pos | REF of raw_pos | ONE_SCALAR_PARA of (string * raw_pos) | PATTERN_MATCH of raw_pos | PATTERN_MATCH_NOT of raw_pos | MULT of (string * raw_pos) +  | CONCAT of raw_pos | POWER of raw_pos | TIGHT_NOT of raw_pos | BIT_NEG of raw_pos | REF of raw_pos | ONE_SCALAR_PARA of (string * raw_pos) | PATTERN_MATCH of raw_pos | PATTERN_MATCH_NOT of raw_pos | MULT of (string * raw_pos) | MULT_L_STR of raw_pos    | PLUS of (string * raw_pos) | BIT_SHIFT of (string * raw_pos) -  | LT of raw_pos | GT of raw_pos | COMPARE_OP of (string * raw_pos) | EQ_OP of (string * raw_pos) +  | LT of raw_pos | GT of raw_pos | COMPARE_OP of (string * raw_pos) | COMPARE_OP_STR of (string * raw_pos) | EQ_OP of (string * raw_pos) | EQ_OP_STR of (string * raw_pos)    | BIT_AND of raw_pos | BIT_OR of raw_pos | BIT_XOR of raw_pos | AND_TIGHT of raw_pos | OR_TIGHT of raw_pos | DOTDOT of (string * raw_pos)    | QUESTION_MARK of raw_pos | COLON of raw_pos | ASSIGN of (string * raw_pos) | COMMA of raw_pos | RIGHT_ARROW of raw_pos | NOT of raw_pos | AND of raw_pos | OR of raw_pos | XOR of raw_pos  and raw_interpolated_string = (string * raw_token list) list -let new_any any spaces pos = { any = any ; spaces = spaces ; pos = pos } +let new_any mcontext any spaces pos = { mcontext = mcontext ; any = any ; spaces = spaces ; pos = pos }  let rec concat_bareword_paren accu = function    | PRINT(s, pos1) :: PAREN(pos2) :: l @@ -65,105 +66,110 @@ let rec concat_bareword_paren accu = function    | e :: l -> concat_bareword_paren (e :: accu) l  let rec raw_token_to_pos_and_token spaces = function -  | NUM(s, pos) -> pos, Parser.NUM(new_any s spaces pos) -  | RAW_STRING(s, pos) -> pos, Parser.RAW_STRING(new_any s spaces pos) -  | RAW_HERE_DOC(r, pos) -> pos, Parser.RAW_HERE_DOC(new_any !r spaces pos) -  | STRING(l, pos) -> pos, Parser.STRING(new_any (raw_interpolated_string_to_tokens l) spaces pos) -  | COMMAND_STRING(l, pos) -> pos, Parser.COMMAND_STRING(new_any (raw_interpolated_string_to_tokens l) spaces pos) -  | QR_PATTERN(s, opts, pos) -> pos, Parser.QR_PATTERN(new_any (raw_interpolated_string_to_tokens s, opts) spaces pos) -  | PATTERN(s, opts, pos) -> pos, Parser.PATTERN(new_any (raw_interpolated_string_to_tokens s, opts) spaces pos) -  | PATTERN_SUBST(from, to_, opts, pos) -> pos, Parser.PATTERN_SUBST(new_any (raw_interpolated_string_to_tokens from, raw_interpolated_string_to_tokens to_, opts) spaces pos) -  | HERE_DOC(l, pos) -> pos, Parser.HERE_DOC(new_any (raw_interpolated_string_to_tokens (fst !l), snd !l) spaces pos) -  | BAREWORD(s, pos) -> pos, Parser.BAREWORD(new_any s spaces pos) -  | BAREWORD_PAREN(s, pos) -> pos, Parser.BAREWORD_PAREN(new_any s spaces pos) -  | REVISION(s, pos) -> pos, Parser.REVISION(new_any s spaces pos) -  | PERL_CHECKER_COMMENT(s, pos) -> pos, Parser.PERL_CHECKER_COMMENT(new_any s spaces pos) -  | PO_COMMENT(s, pos) -> pos, Parser.PO_COMMENT(new_any s spaces pos) -  | POD(s, pos) -> pos, Parser.POD(new_any s spaces pos) -  | LABEL(s, pos) -> pos, Parser.LABEL(new_any s spaces pos) -  | PRINT(s, pos) -> pos, Parser.PRINT(new_any s spaces pos) -  | PRINT_TO_STAR(s, pos) -> pos, Parser.PRINT_TO_STAR(new_any s spaces pos) -  | PRINT_TO_SCALAR(s, pos) -> pos, Parser.PRINT_TO_SCALAR(new_any s spaces pos) -  | QUOTEWORDS(s, pos) -> pos, Parser.QUOTEWORDS(new_any s spaces pos) -  | COMPACT_HASH_SUBSCRIPT(s, pos) -> pos, Parser.COMPACT_HASH_SUBSCRIPT(new_any s spaces pos) -  | SCALAR_IDENT(kind, name, pos) -> pos, Parser.SCALAR_IDENT(new_any (kind, name) spaces pos) -  | ARRAY_IDENT(kind, name, pos) -> pos, Parser.ARRAY_IDENT(new_any (kind, name) spaces pos) -  | HASH_IDENT(kind, name, pos) -> pos, Parser.HASH_IDENT(new_any (kind, name) spaces pos) -  | FUNC_IDENT(kind, name, pos) -> pos, Parser.FUNC_IDENT(new_any (kind, name) spaces pos) -  | STAR_IDENT(kind, name, pos) -> pos, Parser.STAR_IDENT(new_any (kind, name) spaces pos) -  | RAW_IDENT(kind, name, pos) -> pos, Parser.RAW_IDENT(new_any (kind, name) spaces pos) -  | RAW_IDENT_PAREN(kind, name, pos) -> pos, Parser.RAW_IDENT_PAREN(new_any (kind, name) spaces pos) -  | ARRAYLEN_IDENT(kind, name, pos) -> pos, Parser.ARRAYLEN_IDENT(new_any (kind, name) spaces pos) -  | FUNC_DECL_WITH_PROTO(name, proto, pos) -> pos, Parser.FUNC_DECL_WITH_PROTO(new_any (name, proto) spaces pos) - -  | NEW(pos) -> pos, Parser.NEW(new_any () spaces pos) -  | FORMAT(pos) -> pos, Parser.FORMAT(new_any () spaces pos) -  | COMPARE_OP(s, pos) -> pos, Parser.COMPARE_OP(new_any s spaces pos) -  | EQ_OP(s, pos) -> pos, Parser.EQ_OP(new_any s spaces pos) -  | ASSIGN(s, pos) -> pos, Parser.ASSIGN(new_any s spaces pos) -  | FOR(s, pos) -> pos, Parser.FOR(new_any s spaces pos) - -  | DOTDOT(s, pos) -> pos, Parser.DOTDOT(new_any s spaces pos) -  | MULT(s, pos) -> pos, Parser.MULT(new_any s spaces pos) -  | BIT_SHIFT(s, pos) -> pos, Parser.BIT_SHIFT(new_any s spaces pos) -  | PLUS(s, pos) -> pos, Parser.PLUS(new_any s spaces pos) -  | ONE_SCALAR_PARA(s, pos) -> pos, Parser.ONE_SCALAR_PARA(new_any s spaces pos) -  | MY_OUR(s, pos) -> pos, Parser.MY_OUR(new_any s spaces pos) - -  | EOF              (pos) -> pos, Parser.EOF              (new_any () spaces pos) -  | IF               (pos) -> pos, Parser.IF               (new_any () spaces pos) -  | ELSIF            (pos) -> pos, Parser.ELSIF            (new_any () spaces pos) -  | ELSE             (pos) -> pos, Parser.ELSE             (new_any () spaces pos) -  | UNLESS           (pos) -> pos, Parser.UNLESS           (new_any () spaces pos) -  | DO               (pos) -> pos, Parser.DO               (new_any () spaces pos) -  | WHILE            (pos) -> pos, Parser.WHILE            (new_any () spaces pos) -  | UNTIL            (pos) -> pos, Parser.UNTIL            (new_any () spaces pos) -  | CONTINUE         (pos) -> pos, Parser.CONTINUE         (new_any () spaces pos) -  | SUB              (pos) -> pos, Parser.SUB              (new_any () spaces pos) -  | LOCAL            (pos) -> pos, Parser.LOCAL            (new_any () spaces pos) -  | USE              (pos) -> pos, Parser.USE              (new_any () spaces pos) -  | PACKAGE          (pos) -> pos, Parser.PACKAGE          (new_any () spaces pos) -  | BEGIN            (pos) -> pos, Parser.BEGIN            (new_any () spaces pos) -  | END              (pos) -> pos, Parser.END              (new_any () spaces pos) -  | AT               (pos) -> pos, Parser.AT               (new_any () spaces pos) -  | DOLLAR           (pos) -> pos, Parser.DOLLAR           (new_any () spaces pos) -  | PERCENT          (pos) -> pos, Parser.PERCENT          (new_any () spaces pos) -  | AMPERSAND        (pos) -> pos, Parser.AMPERSAND        (new_any () spaces pos) -  | STAR             (pos) -> pos, Parser.STAR             (new_any () spaces pos) -  | ARRAYLEN         (pos) -> pos, Parser.ARRAYLEN         (new_any () spaces pos) -  | SEMI_COLON       (pos) -> pos, Parser.SEMI_COLON       (new_any () spaces pos) -  | PKG_SCOPE        (pos) -> pos, Parser.PKG_SCOPE        (new_any () spaces pos) -  | PAREN            (pos) -> pos, Parser.PAREN            (new_any () spaces pos) -  | PAREN_END        (pos) -> pos, Parser.PAREN_END        (new_any () spaces pos) -  | BRACKET          (pos) -> pos, Parser.BRACKET          (new_any () spaces pos) -  | BRACKET_END      (pos) -> pos, Parser.BRACKET_END      (new_any () spaces pos) -  | BRACKET_HASHREF  (pos) -> pos, Parser.BRACKET_HASHREF  (new_any () spaces pos) -  | ARRAYREF         (pos) -> pos, Parser.ARRAYREF         (new_any () spaces pos) -  | ARRAYREF_END     (pos) -> pos, Parser.ARRAYREF_END     (new_any () spaces pos) -  | ARROW            (pos) -> pos, Parser.ARROW            (new_any () spaces pos) -  | INCR             (pos) -> pos, Parser.INCR             (new_any () spaces pos) -  | DECR             (pos) -> pos, Parser.DECR             (new_any () spaces pos) -  | POWER            (pos) -> pos, Parser.POWER            (new_any () spaces pos) -  | TIGHT_NOT        (pos) -> pos, Parser.TIGHT_NOT        (new_any () spaces pos) -  | BIT_NEG          (pos) -> pos, Parser.BIT_NEG          (new_any () spaces pos) -  | REF              (pos) -> pos, Parser.REF              (new_any () spaces pos) -  | PATTERN_MATCH    (pos) -> pos, Parser.PATTERN_MATCH    (new_any () spaces pos) -  | PATTERN_MATCH_NOT(pos) -> pos, Parser.PATTERN_MATCH_NOT(new_any () spaces pos) -  | LT               (pos) -> pos, Parser.LT               (new_any () spaces pos) -  | GT               (pos) -> pos, Parser.GT               (new_any () spaces pos) -  | BIT_AND          (pos) -> pos, Parser.BIT_AND          (new_any () spaces pos) -  | BIT_OR           (pos) -> pos, Parser.BIT_OR           (new_any () spaces pos) -  | BIT_XOR          (pos) -> pos, Parser.BIT_XOR          (new_any () spaces pos) -  | AND_TIGHT        (pos) -> pos, Parser.AND_TIGHT        (new_any () spaces pos) -  | OR_TIGHT         (pos) -> pos, Parser.OR_TIGHT         (new_any () spaces pos) -  | QUESTION_MARK    (pos) -> pos, Parser.QUESTION_MARK    (new_any () spaces pos) -  | COLON            (pos) -> pos, Parser.COLON            (new_any () spaces pos) -  | COMMA            (pos) -> pos, Parser.COMMA            (new_any () spaces pos) -  | RIGHT_ARROW      (pos) -> pos, Parser.RIGHT_ARROW      (new_any () spaces pos) -  | NOT              (pos) -> pos, Parser.NOT              (new_any () spaces pos) -  | AND              (pos) -> pos, Parser.AND              (new_any () spaces pos) -  | OR               (pos) -> pos, Parser.OR               (new_any () spaces pos) -  | XOR              (pos) -> pos, Parser.XOR              (new_any () spaces pos) +  | INT(s, pos) -> pos, Parser.NUM(new_any M_int s spaces pos) +  | FLOAT(s, pos) -> pos, Parser.NUM(new_any M_float s spaces pos) +  | RAW_STRING(s, pos) -> pos, Parser.RAW_STRING(new_any M_string s spaces pos) +  | RAW_HERE_DOC(r, pos) -> pos, Parser.RAW_HERE_DOC(new_any M_string !r spaces pos) +  | STRING(l, pos) -> pos, Parser.STRING(new_any M_string (raw_interpolated_string_to_tokens l) spaces pos) +  | COMMAND_STRING(l, pos) -> pos, Parser.COMMAND_STRING(new_any (M_mixed (M_string, M_array)) (raw_interpolated_string_to_tokens l) spaces pos) +  | QR_PATTERN(s, opts, pos) -> pos, Parser.QR_PATTERN(new_any M_special (raw_interpolated_string_to_tokens s, opts) spaces pos) +  | PATTERN(s, opts, pos) -> pos, Parser.PATTERN(new_any M_special (raw_interpolated_string_to_tokens s, opts) spaces pos) +  | PATTERN_SUBST(from, to_, opts, pos) -> pos, Parser.PATTERN_SUBST(new_any M_special (raw_interpolated_string_to_tokens from, raw_interpolated_string_to_tokens to_, opts) spaces pos) +  | HERE_DOC(l, pos) -> pos, Parser.HERE_DOC(new_any M_string (raw_interpolated_string_to_tokens (fst !l), snd !l) spaces pos) +  | BAREWORD(s, pos) -> pos, Parser.BAREWORD(new_any M_special s spaces pos) +  | BAREWORD_PAREN(s, pos) -> pos, Parser.BAREWORD_PAREN(new_any M_special s spaces pos) +  | REVISION(s, pos) -> pos, Parser.REVISION(new_any M_revision s spaces pos) +  | PERL_CHECKER_COMMENT(s, pos) -> pos, Parser.PERL_CHECKER_COMMENT(new_any M_special s spaces pos) +  | PO_COMMENT(s, pos) -> pos, Parser.PO_COMMENT(new_any M_special s spaces pos) +  | POD(s, pos) -> pos, Parser.POD(new_any M_special s spaces pos) +  | LABEL(s, pos) -> pos, Parser.LABEL(new_any M_special s spaces pos) +  | PRINT(s, pos) -> pos, Parser.PRINT(new_any M_special s spaces pos) +  | PRINT_TO_STAR(s, pos) -> pos, Parser.PRINT_TO_STAR(new_any M_special s spaces pos) +  | PRINT_TO_SCALAR(s, pos) -> pos, Parser.PRINT_TO_SCALAR(new_any M_special s spaces pos) +  | QUOTEWORDS(s, pos) -> pos, Parser.QUOTEWORDS(new_any M_array s spaces pos) +  | COMPACT_HASH_SUBSCRIPT(s, pos) -> pos, Parser.COMPACT_HASH_SUBSCRIPT(new_any M_special s spaces pos) +  | SCALAR_IDENT(kind, name, pos) -> pos, Parser.SCALAR_IDENT(new_any M_special (kind, name) spaces pos) +  | ARRAY_IDENT(kind, name, pos) -> pos, Parser.ARRAY_IDENT(new_any M_special (kind, name) spaces pos) +  | HASH_IDENT(kind, name, pos) -> pos, Parser.HASH_IDENT(new_any M_special (kind, name) spaces pos) +  | FUNC_IDENT(kind, name, pos) -> pos, Parser.FUNC_IDENT(new_any M_special (kind, name) spaces pos) +  | STAR_IDENT(kind, name, pos) -> pos, Parser.STAR_IDENT(new_any M_special (kind, name) spaces pos) +  | RAW_IDENT(kind, name, pos) -> pos, Parser.RAW_IDENT(new_any M_special (kind, name) spaces pos) +  | RAW_IDENT_PAREN(kind, name, pos) -> pos, Parser.RAW_IDENT_PAREN(new_any M_special (kind, name) spaces pos) +  | ARRAYLEN_IDENT(kind, name, pos) -> pos, Parser.ARRAYLEN_IDENT(new_any M_special (kind, name) spaces pos) +  | FUNC_DECL_WITH_PROTO(name, proto, pos) -> pos, Parser.FUNC_DECL_WITH_PROTO(new_any M_special (name, proto) spaces pos) + +  | NEW(pos) -> pos, Parser.NEW(new_any M_special () spaces pos) +  | FORMAT(pos) -> pos, Parser.FORMAT(new_any M_special () spaces pos) +  | COMPARE_OP(s, pos) -> pos, Parser.COMPARE_OP(new_any M_special s spaces pos) +  | COMPARE_OP_STR(s, pos) -> pos, Parser.COMPARE_OP_STR(new_any M_special s spaces pos) +  | EQ_OP(s, pos) -> pos, Parser.EQ_OP(new_any M_special s spaces pos) +  | EQ_OP_STR(s, pos) -> pos, Parser.EQ_OP_STR(new_any M_special s spaces pos) +  | ASSIGN(s, pos) -> pos, Parser.ASSIGN(new_any M_special s spaces pos) +  | FOR(s, pos) -> pos, Parser.FOR(new_any M_special s spaces pos) + +  | DOTDOT(s, pos) -> pos, Parser.DOTDOT(new_any M_special s spaces pos) +  | MULT(s, pos) -> pos, Parser.MULT(new_any M_special s spaces pos) +  | BIT_SHIFT(s, pos) -> pos, Parser.BIT_SHIFT(new_any M_special s spaces pos) +  | PLUS(s, pos) -> pos, Parser.PLUS(new_any M_special s spaces pos) +  | ONE_SCALAR_PARA(s, pos) -> pos, Parser.ONE_SCALAR_PARA(new_any M_special s spaces pos) +  | MY_OUR(s, pos) -> pos, Parser.MY_OUR(new_any M_special s spaces pos) + +  | EOF              (pos) -> pos, Parser.EOF              (new_any M_special () spaces pos) +  | IF               (pos) -> pos, Parser.IF               (new_any M_special () spaces pos) +  | ELSIF            (pos) -> pos, Parser.ELSIF            (new_any M_special () spaces pos) +  | ELSE             (pos) -> pos, Parser.ELSE             (new_any M_special () spaces pos) +  | UNLESS           (pos) -> pos, Parser.UNLESS           (new_any M_special () spaces pos) +  | DO               (pos) -> pos, Parser.DO               (new_any M_special () spaces pos) +  | WHILE            (pos) -> pos, Parser.WHILE            (new_any M_special () spaces pos) +  | UNTIL            (pos) -> pos, Parser.UNTIL            (new_any M_special () spaces pos) +  | CONTINUE         (pos) -> pos, Parser.CONTINUE         (new_any M_special () spaces pos) +  | SUB              (pos) -> pos, Parser.SUB              (new_any M_special () spaces pos) +  | LOCAL            (pos) -> pos, Parser.LOCAL            (new_any M_special () spaces pos) +  | USE              (pos) -> pos, Parser.USE              (new_any M_special () spaces pos) +  | PACKAGE          (pos) -> pos, Parser.PACKAGE          (new_any M_special () spaces pos) +  | BEGIN            (pos) -> pos, Parser.BEGIN            (new_any M_special () spaces pos) +  | END              (pos) -> pos, Parser.END              (new_any M_special () spaces pos) +  | AT               (pos) -> pos, Parser.AT               (new_any M_special () spaces pos) +  | DOLLAR           (pos) -> pos, Parser.DOLLAR           (new_any M_special () spaces pos) +  | PERCENT          (pos) -> pos, Parser.PERCENT          (new_any M_special () spaces pos) +  | AMPERSAND        (pos) -> pos, Parser.AMPERSAND        (new_any M_special () spaces pos) +  | STAR             (pos) -> pos, Parser.STAR             (new_any M_special () spaces pos) +  | ARRAYLEN         (pos) -> pos, Parser.ARRAYLEN         (new_any M_special () spaces pos) +  | SEMI_COLON       (pos) -> pos, Parser.SEMI_COLON       (new_any M_special () spaces pos) +  | PKG_SCOPE        (pos) -> pos, Parser.PKG_SCOPE        (new_any M_special () spaces pos) +  | PAREN            (pos) -> pos, Parser.PAREN            (new_any M_special () spaces pos) +  | PAREN_END        (pos) -> pos, Parser.PAREN_END        (new_any M_special () spaces pos) +  | BRACKET          (pos) -> pos, Parser.BRACKET          (new_any M_special () spaces pos) +  | BRACKET_END      (pos) -> pos, Parser.BRACKET_END      (new_any M_special () spaces pos) +  | BRACKET_HASHREF  (pos) -> pos, Parser.BRACKET_HASHREF  (new_any M_special () spaces pos) +  | ARRAYREF         (pos) -> pos, Parser.ARRAYREF         (new_any M_special () spaces pos) +  | ARRAYREF_END     (pos) -> pos, Parser.ARRAYREF_END     (new_any M_special () spaces pos) +  | ARROW            (pos) -> pos, Parser.ARROW            (new_any M_special () spaces pos) +  | INCR             (pos) -> pos, Parser.INCR             (new_any M_special () spaces pos) +  | DECR             (pos) -> pos, Parser.DECR             (new_any M_special () spaces pos) +  | POWER            (pos) -> pos, Parser.POWER            (new_any M_special () spaces pos) +  | TIGHT_NOT        (pos) -> pos, Parser.TIGHT_NOT        (new_any M_special () spaces pos) +  | BIT_NEG          (pos) -> pos, Parser.BIT_NEG          (new_any M_special () spaces pos) +  | REF              (pos) -> pos, Parser.REF              (new_any M_special () spaces pos) +  | PATTERN_MATCH    (pos) -> pos, Parser.PATTERN_MATCH    (new_any M_special () spaces pos) +  | PATTERN_MATCH_NOT(pos) -> pos, Parser.PATTERN_MATCH_NOT(new_any M_special () spaces pos) +  | LT               (pos) -> pos, Parser.LT               (new_any M_special () spaces pos) +  | GT               (pos) -> pos, Parser.GT               (new_any M_special () spaces pos) +  | BIT_AND          (pos) -> pos, Parser.BIT_AND          (new_any M_special () spaces pos) +  | BIT_OR           (pos) -> pos, Parser.BIT_OR           (new_any M_special () spaces pos) +  | BIT_XOR          (pos) -> pos, Parser.BIT_XOR          (new_any M_special () spaces pos) +  | AND_TIGHT        (pos) -> pos, Parser.AND_TIGHT        (new_any M_special () spaces pos) +  | OR_TIGHT         (pos) -> pos, Parser.OR_TIGHT         (new_any M_special () spaces pos) +  | QUESTION_MARK    (pos) -> pos, Parser.QUESTION_MARK    (new_any M_special () spaces pos) +  | COLON            (pos) -> pos, Parser.COLON            (new_any M_special () spaces pos) +  | COMMA            (pos) -> pos, Parser.COMMA            (new_any M_special () spaces pos) +  | CONCAT           (pos) -> pos, Parser.CONCAT           (new_any M_special () spaces pos) +  | MULT_L_STR       (pos) -> pos, Parser.MULT_L_STR       (new_any M_special () spaces pos) +  | RIGHT_ARROW      (pos) -> pos, Parser.RIGHT_ARROW      (new_any M_special () spaces pos) +  | NOT              (pos) -> pos, Parser.NOT              (new_any M_special () spaces pos) +  | AND              (pos) -> pos, Parser.AND              (new_any M_special () spaces pos) +  | OR               (pos) -> pos, Parser.OR               (new_any M_special () spaces pos) +  | XOR              (pos) -> pos, Parser.XOR              (new_any M_special () spaces pos)    | SPACE _ | CR -> internal_error "raw_token_to_token" @@ -384,16 +390,18 @@ rule token = parse  | "!~" { PATTERN_MATCH_NOT(pos lexbuf) }  | "*" { MULT(lexeme lexbuf, pos lexbuf) }  | "%" { MULT(lexeme lexbuf, pos lexbuf) } -| "x" { MULT(lexeme lexbuf, pos lexbuf) } +| "x" { MULT_L_STR(pos lexbuf) }  | "+" { PLUS(lexeme lexbuf, pos lexbuf) }  | "-" { PLUS(lexeme lexbuf, pos lexbuf) } -| "." { PLUS(lexeme lexbuf, pos lexbuf) } +| "." { CONCAT(pos lexbuf) }  | "<<" { BIT_SHIFT(lexeme lexbuf, pos lexbuf) }  | ">>" { BIT_SHIFT(lexeme lexbuf, pos lexbuf) }  | "<" { LT(pos lexbuf) }  | ">" { GT(pos lexbuf) } -| "<=" | ">=" | "lt" | "gt" | "le" | "ge" { COMPARE_OP(lexeme lexbuf, pos lexbuf) } -| "==" | "!=" | "<=>" | "eq" | "ne" | "cmp" { EQ_OP(lexeme lexbuf, pos lexbuf) } +| "<=" | ">="  { COMPARE_OP(lexeme lexbuf, pos lexbuf) } +| "lt" | "gt" | "le" | "ge" { COMPARE_OP_STR(lexeme lexbuf, pos lexbuf) } +| "==" | "!=" | "<=>" { EQ_OP(lexeme lexbuf, pos lexbuf) } +| "eq" | "ne" | "cmp" { EQ_OP_STR(lexeme lexbuf, pos lexbuf) }  | "&" { BIT_AND(pos lexbuf) }  | "|" { BIT_OR(pos lexbuf) }  | "^" { BIT_XOR(pos lexbuf) } @@ -616,11 +624,14 @@ rule token = parse      REVISION(lexeme lexbuf, pos lexbuf)    } -| ['0'-'9']* '.' ['0'-'9']+ (['e' 'E']['-' '+']?['0'-'9']+)?  +| ['0'-'9']* '.' ['0'-'9']+ (['e' 'E']['-' '+']?['0'-'9']+)? {  +    not_ok_for_match := lexeme_end lexbuf;  +    FLOAT(lexeme lexbuf, pos lexbuf) +  }  | ['0'-'9'] ['0'-'9' '_']*  (['e' 'E']['-' '+']?['0'-'9']+)?  | "0x" ['0'-'9' 'a'-'f' 'A'-'F']+ {       not_ok_for_match := lexeme_end lexbuf;  -    NUM(lexeme lexbuf, pos lexbuf) +    INT(lexeme lexbuf, pos lexbuf)    }  | '"'   { ins_to_string string lexbuf } diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index 3887e24..f578f4d 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -27,7 +27,7 @@  %token <string Types.any_spaces_pos> FOR PRINT  %token <unit   Types.any_spaces_pos> NEW FORMAT -%token <string Types.any_spaces_pos> COMPARE_OP EQ_OP +%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 @@ -46,7 +46,7 @@  %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 +%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 @@ -74,12 +74,12 @@  %left       AND_TIGHT  %left       BIT_OR BIT_XOR  %left       BIT_AND -%nonassoc   EQ_OP -%nonassoc   LT GT COMPARE_OP +%nonassoc   EQ_OP EQ_OP_STR +%nonassoc   LT GT COMPARE_OP COMPARE_OP_STR  %nonassoc   UNIOP  %left       BIT_SHIFT -%left       PLUS -%left       MULT +%left       PLUS CONCAT +%left       MULT MULT_L_STR  %left       PATTERN_MATCH PATTERN_MATCH_NOT  %right      TIGHT_NOT BIT_NEG REF UNARY_MINUS  %right      POWER @@ -102,76 +102,76 @@ prog: lines EOF {$1.any}  lines: /* A collection of "lines" in the program */  | { default_esp [] } -| sideff { new_esp [$1.any] $1 $1 } -| line lines { new_esp ($1.any @ $2.any) $1 $2 } +| sideff { new_1esp [$1.any] $1 } +| line lines { new_esp $2.mcontext ($1.any @ $2.any) $1 $2 }  line: -| decl { new_esp [$1.any] $1 $1 } -| if_then_else { new_esp [$1.any] $1 $1 } -| loop { new_esp [$1.any] $1 $1 } -| LABEL { sp_cr($1); new_esp [Label $1.any] $1 $1 } -| PERL_CHECKER_COMMENT {sp_p($1); new_esp [Perl_checker_comment($1.any, get_pos $1)] $1 $1} -| semi_colon {new_esp [Semi_colon] $1 $1} -| sideff semi_colon {new_esp [$1.any ; Semi_colon] $1 $1} -| BRACKET lines BRACKET_END {check_block_sub $2 $3; new_esp [Block $2.any] $1 $3} +| 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}  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); check_block_sub $6 $7; to_Call_op "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); check_block_sub $6 $7; to_Call_op "unless" (prio_lo P_loose $3 :: Block $6.any :: $8.any @ $9.any) $1 $9} +| 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; 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); check_block_sub $6 $7; new_esp (prio_lo P_loose $3 :: Block $6.any :: $8.any) $1 $8} +| 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 [Block $3.any] $1 $4} +| 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); check_block_sub $6 $7; to_Call_op "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); check_block_sub $6 $7; to_Call_op "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 "for" [ $3.any; $5.any; $7.any; Block $10.any ] $1 $11} +| 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); check_block_sub $6 $7; check_for_foreach $1 $3; to_Call_op "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 "foreach my" ($1.any @ [ Block $2.any ]) $1 $4} +| 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 [ My_our($2.any, [I_scalar, snd $3.any], get_pos $3); prio_lo P_loose $5 ] $1 $7} +| 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 BRACKET_END {sp_p($1); sp_n($2); check_block_sub $3 $4; new_esp () $1 $4} +| CONTINUE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_sub $3 $4; new_esp $3.mcontext () $1 $4}  sideff: /* An expression which may have a side-effect */ -| expr  {new_esp $1.any.expr $1 $1} -| expr   IF    expr {sp_p($2); sp_p($3);                    call_op_if_infix         (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} -| expr UNLESS  expr {sp_p($2); sp_p($3);                    call_op_unless_infix     (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} -| expr  WHILE  expr {sp_p($2); sp_p($3);                    to_Call_op "while infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} -| expr  UNTIL  expr {sp_p($2); sp_p($3);                    to_Call_op "until infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} -| expr  FOR    expr {sp_p($2); sp_p($3); check_foreach($2); to_Call_op "for infix"   [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} +| expr  { new_1esp $1.any.expr $1 } +| expr   IF    expr {sp_p($2); sp_p($3); mcontext_check M_scalar $3; call_op_if_infix     (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} +| expr UNLESS  expr {sp_p($2); sp_p($3); mcontext_check M_scalar $3; call_op_unless_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} +| expr  WHILE  expr {sp_p($2); sp_p($3); mcontext_check M_scalar $3;                  to_Call_op M_none "while infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} +| expr  UNTIL  expr {sp_p($2); sp_p($3); mcontext_check M_scalar $3;                  to_Call_op M_none "until infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} +| expr  FOR    expr {sp_p($2); sp_p($3); mcontext_check M_list $3; check_foreach($2); to_Call_op M_none "for infix"   [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3}  decl: -| FORMAT BAREWORD ASSIGN {new_esp Too_complex $1 $3} -| FORMAT ASSIGN {new_esp Too_complex $1 $2} -| func_decl semi_colon {if snd $1.any = "" then die_rule "there is no need to pre-declare in Perl!" else (warn_rule "please don't use prototype pre-declaration" ; new_esp Too_complex $1 $2) } -| func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = $1.any in new_esp (sub_declaration (name, proto) []) $1 $3} -| func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_sub $3 $4; new_esp (sub_declaration $1.any $3.any) $1 $4} -| func_decl BRACKET BRACKET expr BRACKET_END            BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_esp (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4)]) $1 $6} -| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_esp (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4); Semi_colon]) $1 $7} -| PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); new_esp (Package $2.any) $1 $3} -| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp (Sub_declaration(Ident(None, "BEGIN", get_pos $1), "", Block $3.any)) $1 $4} -| END   BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp (Sub_declaration(Ident(None, "END",   get_pos $1), "", Block $3.any)) $1 $4} +| FORMAT BAREWORD ASSIGN {new_esp M_special Too_complex $1 $3} +| FORMAT ASSIGN {new_esp M_special Too_complex $1 $2} +| func_decl semi_colon {if snd $1.any = "" then die_rule "there is no need to pre-declare in Perl!" else (warn_rule "please don't use prototype pre-declaration" ; new_esp M_special Too_complex $1 $2) } +| func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = $1.any in new_esp M_none (sub_declaration (name, proto) []) $1 $3} +| func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_sub $3 $4; new_esp M_none (sub_declaration $1.any $3.any) $1 $4} +| func_decl BRACKET BRACKET expr BRACKET_END            BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_esp M_none (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4)]) $1 $6} +| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_esp M_none (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4); Semi_colon]) $1 $7} +| PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); new_esp M_none (Package $2.any) $1 $3} +| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "BEGIN", get_pos $1), "", Block $3.any)) $1 $4} +| END   BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "END",   get_pos $1), "", Block $3.any)) $1 $4}  | use {$1}  use: -| use_word listexpr semi_colon {sp_n($2); new_esp (Use($1.any, $2.any.expr)) $1 $3} -| use_revision RAW_IDENT_PAREN PAREN PAREN_END {new_esp (Use(to_Ident $2, [])) $1 $2} +| use_word listexpr semi_colon {sp_n($2); new_esp M_none (Use($1.any, $2.any.expr)) $1 $3} +| use_revision RAW_IDENT_PAREN PAREN PAREN_END {new_esp M_none (Use(to_Ident $2, [])) $1 $2}  use_word: -| use_revision word comma {new_esp $2.any $1 $3} -| use_revision word {new_esp $2.any $1 $2} -| use_revision {new_esp (Ident(None, "", get_pos $1)) $1 $1} +| use_revision word comma {new_esp M_none $2.any $1 $3} +| use_revision word {new_esp M_none $2.any $1 $2} +| use_revision {new_1esp (Ident(None, "", get_pos $1)) $1 }  use_revision:  | USE REVISION comma {$1} @@ -179,57 +179,62 @@ use_revision:  | USE {$1}  func_decl: -| SUB word { new_esp ($2.any, "") $1 $2} -| FUNC_DECL_WITH_PROTO {new_esp (Ident(None, fst $1.any, get_pos $1), snd $1.any) $1 $1} +| SUB word { new_esp M_none ($2.any, "") $1 $2} +| FUNC_DECL_WITH_PROTO {new_1esp (Ident(None, fst $1.any, get_pos $1), snd $1.any) $1 }  listexpr: /* Basic list expressions */  | %prec PREC_LOW { default_pesp P_tok []}  | argexpr %prec PREC_LOW {$1}  expr: /* Ordinary expressions; logical combinations */ -| expr AND expr {sp_p($2); sp_p($3); to_Call_op_ P_and "and" [ prio_lo P_and $1; prio_lo_after P_and $3 ] $1 $3} -| expr OR  expr {sp_p($2); sp_p($3); to_Call_op_ P_or  "or"  [ prio_lo P_or  $1; prio_lo_after P_or  $3 ] $1 $3} -| argexpr %prec PREC_LOW { new_pesp $1.any.priority (List $1.any.expr) $1 $1 } +| expr AND expr {sp_p($2); sp_p($3); if $1.any.priority <> P_and then mcontext_check M_scalar $1; to_Call_op_ M_none P_and "and" [ prio_lo P_and $1; prio_lo_after P_and $3 ] $1 $3} +| expr OR  expr {sp_p($2); sp_p($3); if $1.any.priority <> P_or  then mcontext_check M_scalar $1; to_Call_op_ M_none P_or  "or"  [ prio_lo P_or  $1; prio_lo_after P_or  $3 ] $1 $3} +| argexpr %prec PREC_LOW { new_1pesp $1.any.priority (List $1.any.expr) $1 }  argexpr: /* Expressions are a list of terms joined by commas */ -| argexpr comma { new_pesp P_comma $1.any.expr $1 $2} -| argexpr comma term {if not_simple ($3.any.expr) then sp_p($3); new_pesp P_comma (followed_by_comma $1 $2 @ [$3.any.expr]) $1 $3} -| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp P_comma (followed_by_comma $1 $2 @ [ Ref(I_hash, $4.any.expr) ]) $1 $5} -| term %prec PREC_LOW { new_pesp $1.any.priority [$1.any.expr] $1 $1 } +| argexpr comma { new_pesp M_list P_comma $1.any.expr $1 $2} +| argexpr comma term {if not_simple ($3.any.expr) then sp_p($3); new_pesp M_list P_comma (followed_by_comma $1 $2 @ [$3.any.expr]) $1 $3} +| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp M_list P_comma (followed_by_comma $1 $2 @ [ Ref(I_hash, $4.any.expr) ]) $1 $5} +| term %prec PREC_LOW { new_1pesp $1.any.priority [$1.any.expr] $1 }  /********************************************************************************/  term: -| term ASSIGN     term {sp_same $2 $3;          let pri = P_assign    in to_Call_op_ pri $2.any [$1.any.expr   ; prio_lo_after pri $3] $1 $3} -| term PLUS       term {sp_same $2 $3;          let pri = P_add       in to_Call_op_ pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term COMPARE_OP term {sp_same $2 $3; sp_p $2; let pri = P_cmp       in to_Call_op_ pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term LT         term {sp_same $2 $3; sp_p $2; let pri = P_cmp       in to_Call_op_ pri "<"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term GT         term {sp_same $2 $3; sp_p $2; let pri = P_cmp       in to_Call_op_ pri ">"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term EQ_OP      term {sp_same $2 $3; sp_p $2; let pri = P_eq        in to_Call_op_ pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term POWER      term {sp_same $2 $3;          let pri = P_tight     in to_Call_op_ pri "**"   [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term BIT_AND    term {sp_same $2 $3; sp_p $2; let pri = P_bit       in to_Call_op_ pri "&"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term BIT_OR     term {sp_same $2 $3;          let pri = P_bit       in to_Call_op_ pri "|"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term BIT_XOR    term {sp_same $2 $3; sp_p $2; let pri = P_bit       in to_Call_op_ pri "^"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term AND_TIGHT  term {sp_same $2 $3; sp_p $2; let pri = P_tight_and in to_Call_op_ pri "&&"   [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term OR_TIGHT   term {sp_same $2 $3; sp_p $2; let pri = P_tight_or  in to_Call_op_ pri "||"   [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term MULT       term {sp_same $2 $3;          let pri = P_mul       in to_Call_op_ pri $2.any [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} -| term DOTDOT     term {sp_same $2 $3;          let pri = P_paren_wanted P_expr  in to_Call_op_ pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term BIT_SHIFT  term {sp_same $2 $3;          let pri = P_paren_wanted P_tight in to_Call_op_ pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term XOR        term {sp_same $2 $3; sp_p $2; let pri = P_paren_wanted P_expr  in to_Call_op_ pri "xor"  [prio_lo pri $1; prio_lo_after pri $3] $1 $3} - -| term ASSIGN     BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ P_assign    $2.any [prio_lo P_assign $1; Ref(I_hash, $4.any.expr)] $1 $5} -| term AND_TIGHT  BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ P_tight_and "&&"   [prio_lo P_assign $1; Ref(I_hash, $4.any.expr)] $1 $5} -| term OR_TIGHT   BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ P_tight_or  "||"   [prio_lo P_assign $1; Ref(I_hash, $4.any.expr)] $1 $5} - - -| term PATTERN_MATCH     PATTERN   {sp_n($2); sp_p($3); check_unneeded_var_dollar_   ($1); let pattern = from_PATTERN $3 in check_simple_pattern pattern ; to_Call_op_ P_expr "m//"  ($1.any.expr :: pattern) $1 $3} -| term PATTERN_MATCH_NOT PATTERN   {sp_n($2); sp_p($3); check_unneeded_var_dollar_not($1); let pattern = from_PATTERN $3 in check_simple_pattern pattern ; to_Call_op_ P_expr "!m//" ($1.any.expr :: pattern) $1 $3} -| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_s  ($1); to_Call_op_ P_expr "s///" ($1.any.expr :: from_PATTERN_SUBST $3) $1 $3} +| term  +   COMPARE_OP_STR term {sp_same $2 $3; sp_p $2; let pri = P_cmp       in to_Call_op_ (mcontext_symops M_string $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term COMPARE_OP term {sp_same $2 $3; sp_p $2; let pri = P_cmp       in to_Call_op_ (mcontext_symops M_float  $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term LT         term {sp_same $2 $3; sp_p $2; let pri = P_cmp       in to_Call_op_ (mcontext_symops M_float  $1 $3) pri "<"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term GT         term {sp_same $2 $3; sp_p $2; let pri = P_cmp       in to_Call_op_ (mcontext_symops M_float  $1 $3) pri ">"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term EQ_OP      term {sp_same $2 $3; sp_p $2; let pri = P_eq        in to_Call_op_ (mcontext_symops M_float  $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term EQ_OP_STR  term {sp_same $2 $3; sp_p $2; let pri = P_eq        in to_Call_op_ (mcontext_symops M_string $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term POWER      term {sp_same $2 $3;          let pri = P_tight     in to_Call_op_ (mcontext_symops M_float  $1 $3) pri "**"   [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term BIT_AND    term {sp_same $2 $3; sp_p $2; let pri = P_bit       in to_Call_op_ (mcontext_symops M_int    $1 $3) pri "&"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term BIT_OR     term {sp_same $2 $3;          let pri = P_bit       in to_Call_op_ (mcontext_symops M_int    $1 $3) pri "|"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term BIT_XOR    term {sp_same $2 $3; sp_p $2; let pri = P_bit       in to_Call_op_ (mcontext_symops M_int    $1 $3) pri "^"    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term AND_TIGHT  term {sp_same $2 $3; sp_p $2; let pri = P_tight_and in to_Call_op_ (mcontext_symops M_scalar $1 $3) pri "&&"   [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term OR_TIGHT   term {sp_same $2 $3; sp_p $2; let pri = P_tight_or  in to_Call_op_ (mcontext_symops M_scalar $1 $3) pri "||"   [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term MULT       term {sp_same $2 $3;          let pri = P_mul       in to_Call_op_ (mcontext_symops M_float  $1 $3) pri $2.any [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} +| term MULT_L_STR term {sp_same $2 $3; mcontext_check M_int $3; let pri = P_mul in to_Call_op_ (if mcontext_lower $1.mcontext M_string then M_string else M_list) pri "x" [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} +| term PLUS       term {sp_same $2 $3;          let pri = P_add       in to_Call_op_ (mcontext_symops M_float  $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term CONCAT     term {sp_same $2 $3;          let pri = P_add       in to_Call_op_ (mcontext_symops M_string $1 $3) pri "."    [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term ASSIGN     term {sp_same $2 $3; mcontext_check_non_none $3 ; let pri = P_assign in to_Call_op_ $3.mcontext     pri $2.any [$1.any.expr   ; prio_lo_after pri $3] $1 $3} +| term DOTDOT     term {sp_same $2 $3;          let pri = P_paren_wanted P_expr  in to_Call_op_ (mcontext_symops M_scalar $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term BIT_SHIFT  term {sp_same $2 $3;          let pri = P_paren_wanted P_tight in to_Call_op_ (mcontext_symops M_int    $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term XOR        term {sp_same $2 $3; sp_p $2; let pri = P_paren_wanted P_expr  in to_Call_op_ (mcontext_symops M_scalar $1 $3) pri "xor"  [prio_lo pri $1; prio_lo_after pri $3] $1 $3} + +| term ASSIGN     BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ (M_ref M_hash) P_assign $2.any [prio_lo P_assign $1; Ref(I_hash, $4.any.expr)] $1 $5} +| term AND_TIGHT  BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ M_scalar P_tight_and "&&"   [prio_lo P_assign $1; Ref(I_hash, $4.any.expr)] $1 $5} +| term OR_TIGHT   BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ M_scalar P_tight_or  "||"   [prio_lo P_assign $1; Ref(I_hash, $4.any.expr)] $1 $5} + + +| term PATTERN_MATCH     PATTERN   {sp_n($2); sp_p($3); check_unneeded_var_dollar_   ($1); let pattern = from_PATTERN $3 in check_simple_pattern pattern ; to_Call_op_ M_array P_expr "m//"  ($1.any.expr :: pattern) $1 $3} +| term PATTERN_MATCH_NOT PATTERN   {sp_n($2); sp_p($3); check_unneeded_var_dollar_not($1); let pattern = from_PATTERN $3 in check_simple_pattern pattern ; to_Call_op_ M_int   P_expr "!m//" ($1.any.expr :: pattern) $1 $3} +| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_s  ($1); to_Call_op_ M_int P_expr "s///" ($1.any.expr :: from_PATTERN_SUBST $3) $1 $3}  | term PATTERN_MATCH_NOT PATTERN_SUBST {die_with_rawpos $2.pos "use =~ instead of !~ and negate the return value"} -| term PATTERN_MATCH     QR_PATTERN {sp_n($2); sp_p($3); to_Call_op_ P_expr "m//"  ($1.any.expr :: from_PATTERN $3) $1 $3} -| term PATTERN_MATCH_NOT QR_PATTERN {sp_n($2); sp_p($3); to_Call_op_ P_expr "!m//" ($1.any.expr :: from_PATTERN $3) $1 $3} -| term PATTERN_MATCH     scalar { new_pesp P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3} -| term PATTERN_MATCH_NOT scalar { new_pesp P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3} +| term PATTERN_MATCH     QR_PATTERN {sp_n($2); sp_p($3); to_Call_op_ M_array P_expr "m//"  ($1.any.expr :: from_PATTERN $3) $1 $3} +| term PATTERN_MATCH_NOT QR_PATTERN {sp_n($2); sp_p($3); to_Call_op_ M_int   P_expr "!m//" ($1.any.expr :: from_PATTERN $3) $1 $3} +| term PATTERN_MATCH     scalar { new_pesp M_array P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3} +| term PATTERN_MATCH_NOT scalar { new_pesp M_int   P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3}  | term PATTERN_MATCH     RAW_STRING {die_with_rawpos $3.pos "use a regexp, not a string"}  | term PATTERN_MATCH_NOT RAW_STRING {die_with_rawpos $3.pos "use a regexp, not a string"} @@ -237,10 +242,10 @@ term:  | term PATTERN_MATCH_NOT STRING {die_with_rawpos $3.pos "use a regexp, not a string"} -| term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, prio_lo_after P_ternary $5)) $1 $5} -| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); to_Call_op_ P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, Ref(I_hash, $6.any.expr))) $1 $7} -| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); to_Call_op_ P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, Ref(I_hash, $4.any.expr), prio_lo_after P_ternary $7)) $1 $7} -| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); to_Call_op_ P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, Ref(I_hash, $4.any.expr), Ref(I_hash, $8.any.expr))) $1 $9} +| term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); mcontext_check M_scalar $1; to_Call_op_ (mcontext_merge $3.mcontext $5.mcontext) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, prio_lo_after P_ternary $5)) $1 $5} +| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_scalar $1; to_Call_op_ (mcontext_merge $3.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, Ref(I_hash, $6.any.expr))) $1 $7} +| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_scalar $1; to_Call_op_ (mcontext_merge $7.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, Ref(I_hash, $4.any.expr), prio_lo_after P_ternary $7)) $1 $7} +| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); mcontext_check M_scalar $1; to_Call_op_ (M_ref M_hash) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, Ref(I_hash, $4.any.expr), Ref(I_hash, $8.any.expr))) $1 $9}  /* Unary operators and terms */ @@ -249,45 +254,45 @@ term:      match $1.any with      | "+" ->  	warn_rule "don't use unary +" ; -	to_Call_op_ P_tight "+ unary" [$2.any.expr] $1 $2 +	to_Call_op_ (mcontext_unop M_float $2) P_tight "+ unary" [$2.any.expr] $1 $2      | "-" -> -	to_Call_op_ P_tight "- unary" [$2.any.expr] $1 $2 +	to_Call_op_ (mcontext_unop M_float $2) P_tight "- unary" [$2.any.expr] $1 $2      | _ -> die_rule "syntax error"  } -| TIGHT_NOT term {check_negatable_expr $2; to_Call_op_ P_tight "not" [$2.any.expr] $1 $2} -| BIT_NEG term {to_Call_op_ P_expr "~" [$2.any.expr] $1 $2} -| INCR term    {sp_0($2); to_Call_op_ P_tight "++" [$2.any.expr] $1 $2} -| DECR term    {sp_0($2); to_Call_op_ P_tight "--" [$2.any.expr] $1 $2} -| term INCR    {sp_0($2); to_Call_op_ P_tight "++ post" [$1.any.expr] $1 $2} -| term DECR    {sp_0($2); to_Call_op_ P_tight "-- post" [$1.any.expr] $1 $2} -| NOT argexpr  {warn_rule "don't use \"not\", use \"!\" instead"; to_Call_op_ P_and "not" ($2.any.expr) $1 $2} +| TIGHT_NOT term {check_negatable_expr $2; to_Call_op_ (mcontext_unop M_scalar $2) P_tight "not" [$2.any.expr] $1 $2} +| BIT_NEG term {to_Call_op_ (mcontext_unop M_int $2) P_expr "~" [$2.any.expr] $1 $2} +| INCR term    {sp_0($2); to_Call_op_ (mcontext_unop M_int $2) P_tight "++" [$2.any.expr] $1 $2} +| DECR term    {sp_0($2); to_Call_op_ (mcontext_unop M_int $2) P_tight "--" [$2.any.expr] $1 $2} +| term INCR    {sp_0($2); to_Call_op_ (mcontext_unop M_int $1) P_tight "++ post" [$1.any.expr] $1 $2} +| term DECR    {sp_0($2); to_Call_op_ (mcontext_unop M_int $1) P_tight "-- post" [$1.any.expr] $1 $2} +| NOT argexpr  {warn_rule "don't use \"not\", use \"!\" instead"; to_Call_op_ (mcontext_unop M_scalar $2) P_and "not" ($2.any.expr) $1 $2}  /* Constructors for anonymous data */ -| ARRAYREF ARRAYREF_END {sp_0($2); new_pesp P_expr (Ref(I_array, List[])) $1 $2} -| arrayref_start ARRAYREF_END {(if $1.any = [] then sp_0 else sp_p)($2) ; new_pesp P_expr (Ref(I_array, List $1.any)) $1 $2} -| arrayref_start expr ARRAYREF_END {sp_same $2 $3; new_pesp P_expr (Ref(I_array, List($1.any @ [$2.any.expr]))) $1 $3} -| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_same $2 $5; new_pesp P_expr (Ref(I_array, List($1.any @ [Ref(I_hash, $3.any.expr)]))) $1 $5} +| ARRAYREF ARRAYREF_END {sp_0($2); new_pesp (M_ref M_array) P_expr (Ref(I_array, List[])) $1 $2} +| arrayref_start ARRAYREF_END {(if $1.any = [] then sp_0 else sp_p)($2) ; new_pesp (M_ref M_array) P_expr (Ref(I_array, List $1.any)) $1 $2} +| arrayref_start expr ARRAYREF_END {sp_same $2 $3; new_pesp (M_ref M_array) P_expr (Ref(I_array, List($1.any @ [$2.any.expr]))) $1 $3} +| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_same $2 $5; new_pesp (M_ref M_array) P_expr (Ref(I_array, List($1.any @ [Ref(I_hash, $3.any.expr)]))) $1 $5} -| BRACKET BRACKET_END {new_pesp P_expr (Ref(I_hash, List [])) $1 $2} /* empty hash */ -| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); new_pesp P_expr (Ref(I_hash, $2.any.expr)) $1 $3} /* { foo => "Bar" } */ -| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp P_expr (anonymous_sub (new_esp [] $2 $2)) $1 $3} -| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_pesp P_expr (anonymous_sub $3) $1 $4} +| BRACKET BRACKET_END {new_pesp (M_ref M_hash) P_expr (Ref(I_hash, List [])) $1 $2} /* empty hash */ +| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); new_pesp (M_ref M_hash) P_expr (Ref(I_hash, $2.any.expr)) $1 $3} /* { foo => "Bar" } */ +| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (anonymous_sub (new_esp (M_ref M_array) [] $2 $2)) $1 $3} +| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_pesp (M_ref M_sub) P_expr (anonymous_sub $3) $1 $4} -| termdo {new_pesp P_tok $1.any $1 $1} -| REF term {new_pesp P_expr (Ref(I_scalar, $2.any.expr)) $1 $2} /* \$x, \@y, \%z */ -| my_our %prec UNIOP {new_pesp P_expr $1.any $1 $1} -| LOCAL term    %prec UNIOP {sp_n($2); new_pesp P_expr (to_Local $2) $1 $2} +| termdo {new_1pesp P_tok $1.any $1} +| REF term {new_pesp (M_ref $2.mcontext) P_expr (Ref(I_scalar, $2.any.expr)) $1 $2} /* \$x, \@y, \%z */ +| my_our %prec UNIOP {new_1pesp P_expr $1.any $1} +| LOCAL term    %prec UNIOP {sp_n($2); new_pesp $2.mcontext P_expr (to_Local $2) $1 $2} -| parenthesized {new_pesp $1.any.priority (List $1.any.expr) $1 $1} /* (1, 2) */ -| parenthesized arrayref {sp_0($2); new_pesp P_tok (to_Deref_with(I_array, (if is_only_one_in_List $2.any then I_scalar else I_array), List $1.any.expr, List $2.any)) $1 $2} /* list indexing or slicing */ +| parenthesized {new_1pesp $1.any.priority (List $1.any.expr) $1} /* (1, 2) */ +| parenthesized arrayref {sp_0($2); let is_slice = not (is_only_one_in_List $2.any) in new_pesp (if is_slice then M_list else M_scalar) P_tok (to_Deref_with(I_array, (if is_slice then I_array else I_scalar), List $1.any.expr, List $2.any)) $1 $2} /* list indexing or slicing */ -| variable {new_pesp P_tok $1.any $1 $1} +| variable {new_1pesp P_tok $1.any $1} -| subscripted {new_pesp P_tok $1.any $1 $1} +| subscripted {new_1pesp P_tok $1.any $1} -| array arrayref {new_pesp P_expr (to_Deref_with(I_array, I_array, from_array $1, List $2.any)) $1 $2} /* array slice: @array[vals] */ -| array BRACKET expr BRACKET_END {sp_0($2); sp_0($3); sp_0($4); new_pesp P_expr (to_Deref_with(I_hash, I_array, from_array $1, $3.any.expr)) $1 $4} /* hash slice: @hash{@keys} */ +| array arrayref {new_pesp M_list P_expr (to_Deref_with(I_array, I_array, from_array $1, List $2.any)) $1 $2} /* array slice: @array[vals] */ +| array BRACKET expr BRACKET_END {sp_0($2); sp_0($3); sp_0($4); new_pesp M_list P_expr (to_Deref_with(I_hash, I_array, from_array $1, $3.any.expr)) $1 $4} /* hash slice: @hash{@keys} */  /* function_calls */  | ONE_SCALAR_PARA RAW_STRING               {call_one_scalar_para $1 [to_Raw_string $2] $1 $2} @@ -300,114 +305,114 @@ term:  | ONE_SCALAR_PARA word argexpr {check_parenthesized_first_argexpr_with_Ident  $2.any $3; call_one_scalar_para $1 [call(Deref(I_func, $2.any), $3.any.expr)] $1 $3} /* ref foo $a, $b */  | ONE_SCALAR_PARA hash PKG_SCOPE {sp_0($3); call_one_scalar_para $1 [ Call(Too_complex, [$2.any]) ] $1 $3} /* keys %main:: */ -| func parenthesized {sp_0($2); new_pesp P_tok (call_func true ($1.any, $2.any.expr)) $1 $2} /* &foo(@args) */ -| word argexpr {check_parenthesized_first_argexpr_with_Ident  $1.any $2; new_pesp P_call_no_paren (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} /* foo $a, $b */ -| word_paren parenthesized {sp_0($2); new_pesp P_tok (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} /* foo(@args) */ -| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; new_pesp (if $5.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub $3 :: $5.any.expr)) $1 $5} /* map { foo } @bar */ -| word BRACKET BRACKET expr BRACKET_END            BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_pesp (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub(new_esp [ Ref(I_hash, $4.any.expr) ] $4 $4) :: $7.any.expr)) $1 $7} /* map { { foo } } @bar */ -| word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_pesp (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub(new_esp [ Ref(I_hash, $4.any.expr); Semi_colon ] $4 $4) :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */ - -| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); new_pesp P_tok (to_Method_call($1.any.expr, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */ -| term ARROW word_or_scalar {sp_0($2); sp_0($3); new_pesp P_tok (to_Method_call($1.any.expr, $3.any, [])) $1 $3} /* $foo->bar */ -| term ARROW MULT parenthesized {check_MULT_is_x $3; sp_0($2); sp_0($3); sp_0($4); new_pesp P_tok (to_Method_call($1.any.expr, Ident(None, "x", get_pos $3), $4.any.expr)) $1 $4} /* $foo->bar(list) */ -| term ARROW MULT {check_MULT_is_x $3; sp_0($2); sp_0($3); new_pesp P_tok (to_Method_call($1.any.expr, Ident(None, "x", get_pos $3), [])) $1 $3} /* $foo->bar */ -| term ARROW FOR  parenthesized {sp_0($2); sp_0($3); sp_0($4); new_pesp P_tok (to_Method_call($1.any.expr, Ident(None, $3.any, get_pos $3), $4.any.expr)) $1 $4} /* $foo->bar(list) */ -| term ARROW FOR  {sp_0($2); sp_0($3); new_pesp P_tok (to_Method_call($1.any.expr, Ident(None, $3.any, get_pos $3), [])) $1 $3} /* $foo->bar */ - -| NEW word { sp_n($2); new_pesp P_call_no_paren (to_Method_call ($2.any, Ident(None, "new", get_pos $1), [])) $1 $2} /* new Class */ -| NEW word_paren parenthesized { sp_n($2); sp_0($3); new_pesp P_call_no_paren (to_Method_call($2.any, Ident(None, "new", get_pos $1), $3.any.expr)) $1 $3} /* new Class(...) */ +| func parenthesized {sp_0($2); new_pesp M_unknown P_tok (call_func true ($1.any, $2.any.expr)) $1 $2} /* &foo(@args) */ +| word argexpr {check_parenthesized_first_argexpr_with_Ident  $1.any $2; new_pesp M_unknown P_call_no_paren (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} /* foo $a, $b */ +| word_paren parenthesized {sp_0($2); new_pesp M_unknown P_tok (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} /* foo(@args) */ +| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; new_pesp M_unknown (if $5.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub $3 :: $5.any.expr)) $1 $5} /* map { foo } @bar */ +| word BRACKET BRACKET expr BRACKET_END            BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_pesp M_unknown (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub(new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr) ] $4 $4) :: $7.any.expr)) $1 $7} /* map { { foo } } @bar */ +| word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_pesp M_unknown (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub(new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr); Semi_colon ] $4 $4) :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */ + +| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */ +| term ARROW word_or_scalar {sp_0($2); sp_0($3); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, [])) $1 $3} /* $foo->bar */ +| term ARROW MULT_L_STR parenthesized {sp_0($2); sp_0($3); sp_0($4); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, Ident(None, "x", get_pos $3), $4.any.expr)) $1 $4} /* $foo->bar(list) */ +| term ARROW MULT_L_STR {sp_0($2); sp_0($3); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, Ident(None, "x", get_pos $3), [])) $1 $3} /* $foo->bar */ +| term ARROW FOR  parenthesized {sp_0($2); sp_0($3); sp_0($4); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, Ident(None, $3.any, get_pos $3), $4.any.expr)) $1 $4} /* $foo->bar(list) */ +| term ARROW FOR  {sp_0($2); sp_0($3); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, Ident(None, $3.any, get_pos $3), [])) $1 $3} /* $foo->bar */ + +| NEW word { sp_n($2); new_pesp (M_ref M_unknown) P_call_no_paren (to_Method_call ($2.any, Ident(None, "new", get_pos $1), [])) $1 $2} /* new Class */ +| NEW word_paren parenthesized { sp_n($2); sp_0($3); new_pesp (M_ref M_unknown) P_call_no_paren (to_Method_call($2.any, Ident(None, "new", get_pos $1), $3.any.expr)) $1 $3} /* new Class(...) */  | NEW word terminal { die_rule "you must parenthesize parameters: \"new Class(...)\" instead of \"new Class ...\"" }  | NEW word variable { die_rule "you must parenthesize parameters: \"new Class(...)\" instead of \"new Class ...\"" } -| PRINT { to_Call_op_ P_call_no_paren $1.any (var_STDOUT :: [ var_dollar_ (get_pos $1) ]) $1 $1} -| PRINT argexpr {check_parenthesized_first_argexpr  $1.any $2; to_Call_op_ P_call_no_paren $1.any (var_STDOUT :: $2.any.expr) $1 $2} -| PRINT_TO_SCALAR         { to_Call_op_ P_call_no_paren (fst $1.any) (var_STDOUT :: [ Deref(I_scalar, Ident(None, snd $1.any, get_pos $1)) ]) $1 $1} -| PRINT_TO_SCALAR argexpr { to_Call_op_ P_call_no_paren (fst $1.any) (Deref(I_scalar, Ident(None, snd $1.any, get_pos $1)) :: $2.any.expr) $1 $2} -| PRINT_TO_STAR           { to_Call_op_ P_call_no_paren (fst $1.any) (Deref(I_star, Ident(None, snd $1.any, get_pos $1)) :: [ var_dollar_ (get_pos $1) ]) $1 $1} -| PRINT_TO_STAR argexpr   { to_Call_op_ P_call_no_paren (fst $1.any) (Deref(I_star, Ident(None, snd $1.any, get_pos $1)) :: $2.any.expr) $1 $2} +| PRINT { to_Call_op_ M_int P_call_no_paren $1.any (var_STDOUT :: [ var_dollar_ (get_pos $1) ]) $1 $1} +| PRINT argexpr {check_parenthesized_first_argexpr  $1.any $2; to_Call_op_ M_int P_call_no_paren $1.any (var_STDOUT :: $2.any.expr) $1 $2} +| PRINT_TO_SCALAR         { to_Call_op_ M_int P_call_no_paren (fst $1.any) (var_STDOUT :: [ Deref(I_scalar, Ident(None, snd $1.any, get_pos $1)) ]) $1 $1} +| PRINT_TO_SCALAR argexpr { to_Call_op_ M_int P_call_no_paren (fst $1.any) (Deref(I_scalar, Ident(None, snd $1.any, get_pos $1)) :: $2.any.expr) $1 $2} +| PRINT_TO_STAR           { to_Call_op_ M_int P_call_no_paren (fst $1.any) (Deref(I_star, Ident(None, snd $1.any, get_pos $1)) :: [ var_dollar_ (get_pos $1) ]) $1 $1} +| PRINT_TO_STAR argexpr   { to_Call_op_ M_int P_call_no_paren (fst $1.any) (Deref(I_star, Ident(None, snd $1.any, get_pos $1)) :: $2.any.expr) $1 $2} -| hash PKG_SCOPE {sp_0($2); new_pesp P_tok (Call(Too_complex, [$1.any])) $1 $2} /* %main:: */ +| hash PKG_SCOPE {sp_0($2); new_pesp M_hash P_tok (Call(Too_complex, [$1.any])) $1 $2} /* %main:: */  | terminal {$1}  terminal: -| word {new_pesp P_tok (check_word_alone $1.any) $1 $1} -| NUM {new_pesp P_tok (Num($1.any, get_pos $1)) $1 $1} -| STRING {new_pesp P_tok (to_String true $1) $1 $1} -| RAW_STRING {new_pesp P_tok (to_Raw_string $1) $1 $1} -| REVISION {new_pesp P_tok (to_Raw_string $1) $1 $1} -| COMMAND_STRING {to_Call_op_ P_tok "``" [to_String false $1] $1 $1} -| QUOTEWORDS {to_Call_op_ P_tok "qw" [to_Raw_string $1] $1 $1} -| HERE_DOC {new_pesp P_tok (to_String false (new_esp (fst $1.any) $1 $1)) $1 $1} -| RAW_HERE_DOC {new_pesp P_tok (Raw_string(fst $1.any, raw_pos2pos (snd $1.any))) $1 $1} -| QR_PATTERN {to_Call_op_ P_tok "qr//" (from_PATTERN $1) $1 $1} -| PATTERN {to_Call_op_ P_expr "m//" (var_dollar_ (get_pos $1) :: from_PATTERN $1) $1 $1} -| PATTERN_SUBST {to_Call_op_ P_expr "s///" (var_dollar_ (get_pos $1) :: from_PATTERN_SUBST $1) $1 $1} -| diamond {new_pesp P_expr $1.any $1 $1} +| word {word_alone $1} +| NUM {new_1pesp P_tok (Num($1.any, get_pos $1)) $1} +| STRING {new_1pesp P_tok (to_String true $1) $1} +| RAW_STRING {new_1pesp P_tok (to_Raw_string $1) $1} +| REVISION {new_1pesp P_tok (to_Raw_string $1) $1} +| COMMAND_STRING {to_Call_op_ (M_mixed(M_string, M_list)) P_tok "``" [to_String false $1] $1 $1} +| QUOTEWORDS {to_Call_op_ M_list P_tok "qw" [to_Raw_string $1] $1 $1} +| HERE_DOC {new_1pesp P_tok (to_String false (new_1esp (fst $1.any) $1)) $1 } +| RAW_HERE_DOC {new_1pesp P_tok (Raw_string(fst $1.any, raw_pos2pos (snd $1.any))) $1} +| QR_PATTERN {to_Call_op_ M_string P_tok "qr//" (from_PATTERN $1) $1 $1} +| PATTERN {to_Call_op_ M_array P_expr "m//" (var_dollar_ (get_pos $1) :: from_PATTERN $1) $1 $1} +| PATTERN_SUBST {to_Call_op_ M_int P_expr "s///" (var_dollar_ (get_pos $1) :: from_PATTERN_SUBST $1) $1 $1} +| diamond {new_1pesp P_expr $1.any $1}  diamond: -| LT GT {sp_0($2); to_Call_op "<>" [] $1 $2} -| LT term GT {sp_0($2); sp_0($3); to_Call_op "<>" [$2.any.expr] $1 $3} +| LT GT {sp_0($2); to_Call_op (M_mixed(M_string, M_list)) "<>" [] $1 $2} +| LT term GT {sp_0($2); sp_0($3); to_Call_op (M_mixed(M_string, M_list)) "<>" [$2.any.expr] $1 $3}  subscripted: /* Some kind of subscripted expression */ -| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ -| scalar bracket_subscript             {sp_0($2); check_scalar_subscripted $1; new_esp (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any               )) $1 $2} /* $foo{bar} */ -| scalar arrayref                      {sp_0($2); check_scalar_subscripted $1; new_esp (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ -| term ARROW bracket_subscript         {sp_0($2); sp_0($3); check_arrow_needed $1 $2; new_esp (to_Deref_with(I_hash , I_scalar, $1.any.expr, $3.any               )) $1 $3} /* somehref->{bar} */ -| term ARROW arrayref                  {sp_0($2); sp_0($3); check_arrow_needed $1 $2; new_esp (to_Deref_with(I_array, I_scalar, $1.any.expr, only_one_array_ref $3)) $1 $3} /* somearef->[$element] */ -| term ARROW parenthesized             {sp_0($2); sp_0($3); new_esp (to_Deref_with(I_func , I_scalar, $1.any.expr, List($3.any.expr))) $1 $3} /* $subref->(@args) */ -| subscripted bracket_subscript        {sp_0($2); new_esp (to_Deref_with(I_hash , I_scalar, $1.any, $2.any               )) $1 $2} /* $foo->[bar]{baz} */ -| subscripted arrayref                 {sp_0($2); new_esp (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */ -| subscripted parenthesized            {sp_0($2); new_esp (to_Deref_with(I_func , I_scalar, $1.any, List($2.any.expr))) $1 $2} /* $foo->{bar}(@args) */ +| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ +| scalar bracket_subscript             {sp_0($2); check_scalar_subscripted $1; new_esp M_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any               )) $1 $2} /* $foo{bar} */ +| scalar arrayref                      {sp_0($2); check_scalar_subscripted $1; new_esp M_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ +| term ARROW bracket_subscript         {sp_0($2); sp_0($3); check_arrow_needed $1 $2; new_esp M_scalar (to_Deref_with(I_hash , I_scalar, $1.any.expr, $3.any               )) $1 $3} /* somehref->{bar} */ +| term ARROW arrayref                  {sp_0($2); sp_0($3); check_arrow_needed $1 $2; new_esp M_scalar (to_Deref_with(I_array, I_scalar, $1.any.expr, only_one_array_ref $3)) $1 $3} /* somearef->[$element] */ +| term ARROW parenthesized             {sp_0($2); sp_0($3); new_esp M_scalar (to_Deref_with(I_func , I_scalar, $1.any.expr, List($3.any.expr))) $1 $3} /* $subref->(@args) */ +| subscripted bracket_subscript        {sp_0($2); new_esp M_scalar (to_Deref_with(I_hash , I_scalar, $1.any, $2.any               )) $1 $2} /* $foo->[bar]{baz} */ +| subscripted arrayref                 {sp_0($2); new_esp M_scalar (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */ +| subscripted parenthesized            {sp_0($2); new_esp M_scalar (to_Deref_with(I_func , I_scalar, $1.any, List($2.any.expr))) $1 $2} /* $foo->{bar}(@args) */  restricted_subscripted: /* Some kind of subscripted expression */ -| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ -| scalar bracket_subscript             {sp_0($2); check_scalar_subscripted $1; new_esp (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any               )) $1 $2} /* $foo{bar} */ -| scalar arrayref                      {sp_0($2); check_scalar_subscripted $1; new_esp (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ -| restricted_subscripted bracket_subscript        {sp_0($2); new_esp (to_Deref_with(I_hash , I_scalar, $1.any, $2.any               )) $1 $2} /* $foo->[bar]{baz} */ -| restricted_subscripted arrayref                 {sp_0($2); new_esp (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */ -| restricted_subscripted parenthesized            {sp_0($2); new_esp (to_Deref_with(I_func , I_scalar, $1.any, List($2.any.expr))) $1 $2} /* $foo->{bar}(@args) */ +| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ +| scalar bracket_subscript             {sp_0($2); check_scalar_subscripted $1; new_esp M_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any               )) $1 $2} /* $foo{bar} */ +| scalar arrayref                      {sp_0($2); check_scalar_subscripted $1; new_esp M_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ +| restricted_subscripted bracket_subscript        {sp_0($2); new_esp M_scalar (to_Deref_with(I_hash , I_scalar, $1.any, $2.any               )) $1 $2} /* $foo->[bar]{baz} */ +| restricted_subscripted arrayref                 {sp_0($2); new_esp M_scalar (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */ +| restricted_subscripted parenthesized            {sp_0($2); new_esp M_scalar (to_Deref_with(I_func , I_scalar, $1.any, List($2.any.expr))) $1 $2} /* $foo->{bar}(@args) */  arrayref: -| arrayref_start ARRAYREF_END {sp_0($2); new_esp $1.any $1 $2} -| arrayref_start expr ARRAYREF_END {sp_0($3); new_esp ($1.any @ [$2.any.expr]) $1 $3} -| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_p($2); sp_p($4); sp_0($5); new_esp ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5} +| arrayref_start ARRAYREF_END {sp_0($2); new_esp (M_ref M_array) $1.any $1 $2} +| arrayref_start expr ARRAYREF_END {sp_0($3); new_esp (M_ref M_array) ($1.any @ [$2.any.expr]) $1 $3} +| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_p($2); sp_p($4); sp_0($5); new_esp (M_ref M_hash) ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5}  parenthesized: -| parenthesized_start PAREN_END {sp_0_or_cr($2); new_pesp (if $1.any = [] then P_tok else P_paren P_comma) $1.any $1 $2} -| parenthesized_start expr PAREN_END {sp_0_or_cr($3); new_pesp (P_paren (if $1.any = [] then $2.any.priority else P_comma)) ($1.any @ [(if $1.any = [] then prio_lo P_loose else prio_lo_after P_comma) $2]) $1 $3} -| parenthesized_start BRACKET expr BRACKET_END PAREN_END {sp_p($4); sp_0_or_cr($5); new_pesp (P_paren (if $1.any = [] then P_expr else P_comma)) ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5} +| parenthesized_start PAREN_END {sp_0_or_cr($2); new_pesp (if $1.any = [] then M_list else $1.mcontext) (if $1.any = [] then P_tok else P_paren P_comma) $1.any $1 $2} +| parenthesized_start expr PAREN_END {sp_0_or_cr($3); new_pesp (if $1.any = [] then $2.mcontext else M_list) (P_paren (if $1.any = [] then $2.any.priority else P_comma)) ($1.any @ [(if $1.any = [] then prio_lo P_loose else prio_lo_after P_comma) $2]) $1 $3} +| parenthesized_start BRACKET expr BRACKET_END PAREN_END {sp_p($4); sp_0_or_cr($5); new_pesp (if $1.any = [] then M_ref M_hash else M_list) (P_paren (if $1.any = [] then P_expr else P_comma)) ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5}  arrayref_start: -| ARRAYREF {new_esp [] $1 $1} -| arrayref_start BRACKET expr BRACKET_END comma {sp_p($2); sp_p($3); sp_p($4); new_esp ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5} +| ARRAYREF {new_1esp [] $1 } +| arrayref_start BRACKET expr BRACKET_END comma {sp_p($2); sp_p($3); sp_p($4); new_esp M_special ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5}  parenthesized_start: -| PAREN {new_esp [] $1 $1} -| parenthesized_start BRACKET expr BRACKET_END comma {(if $1.any = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); new_esp ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5} +| PAREN {new_1esp [] $1 } +| parenthesized_start BRACKET expr BRACKET_END comma {(if $1.any = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); new_esp (M_ref M_hash) ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5}  my_our: /* Things that can be "my"'d */ -| my_our_paren     PAREN_END {sp_0($2); if snd $1.any <> [] && fstfst $1.any then die_rule "syntax error";       new_esp (My_our(sndfst $1.any, snd $1.any, get_pos $1)) $1 $2} -| my_our_paren SCALAR_IDENT PAREN_END {(if snd $1.any = [] then sp_0 else sp_1)($2); check_my_our_paren $1; new_esp (My_our(sndfst $1.any, snd $1.any @ [I_scalar, snd $2.any], pos_range $1 $3)) $1 $3} -| my_our_paren HASH_IDENT   PAREN_END {(if snd $1.any = [] then sp_0 else sp_1)($2); check_my_our_paren $1; new_esp (My_our(sndfst $1.any, snd $1.any @ [I_hash,   snd $2.any], pos_range $1 $3)) $1 $3} -| my_our_paren ARRAY_IDENT  PAREN_END {(if snd $1.any = [] then sp_0 else sp_1)($2); check_my_our_paren $1; new_esp (My_our(sndfst $1.any, snd $1.any @ [I_array,  snd $2.any], pos_range $1 $3)) $1 $3} -| MY_OUR SCALAR_IDENT {new_esp (My_our($1.any, [I_scalar, snd $2.any], get_pos $2)) $1 $2} -| MY_OUR HASH_IDENT   {new_esp (My_our($1.any, [I_hash,   snd $2.any], get_pos $2)) $1 $2} -| MY_OUR ARRAY_IDENT  {new_esp (My_our($1.any, [I_array,  snd $2.any], get_pos $2)) $1 $2} +| my_our_paren     PAREN_END {sp_0($2); if snd $1.any <> [] && fstfst $1.any then die_rule "syntax error";  new_esp M_none (My_our(sndfst $1.any, snd $1.any, get_pos $1)) $1 $2} +| my_our_paren SCALAR_IDENT PAREN_END {(if snd $1.any = [] then sp_0 else sp_1)($2); check_my_our_paren $1; new_esp M_none (My_our(sndfst $1.any, snd $1.any @ [I_scalar, snd $2.any], pos_range $1 $3)) $1 $3} +| my_our_paren HASH_IDENT   PAREN_END {(if snd $1.any = [] then sp_0 else sp_1)($2); check_my_our_paren $1; new_esp M_none (My_our(sndfst $1.any, snd $1.any @ [I_hash,   snd $2.any], pos_range $1 $3)) $1 $3} +| my_our_paren ARRAY_IDENT  PAREN_END {(if snd $1.any = [] then sp_0 else sp_1)($2); check_my_our_paren $1; new_esp M_none (My_our(sndfst $1.any, snd $1.any @ [I_array,  snd $2.any], pos_range $1 $3)) $1 $3} +| MY_OUR SCALAR_IDENT {new_esp M_scalar (My_our($1.any, [I_scalar, snd $2.any], get_pos $2)) $1 $2} +| MY_OUR HASH_IDENT   {new_esp M_hash   (My_our($1.any, [I_hash,   snd $2.any], get_pos $2)) $1 $2} +| MY_OUR ARRAY_IDENT  {new_esp M_array  (My_our($1.any, [I_array,  snd $2.any], get_pos $2)) $1 $2}  my_our_paren: -| MY_OUR PAREN {sp_1($2); new_esp ((true, $1.any), []) $1 $2} -| my_our_paren comma {if fstfst $1.any then die_rule "syntax error"; new_esp ((true, sndfst $1.any), snd $1.any) $1 $2} -| my_our_paren BAREWORD {check_my_our_paren $1; if $2.any <> "undef" then die_rule "scalar expected"; new_esp ((false, sndfst $1.any), snd $1.any @ [I_raw, $2.any]) $1 $2} -| my_our_paren SCALAR_IDENT {check_my_our_paren $1; new_esp ((false, sndfst $1.any), snd $1.any @ [I_scalar, snd $2.any]) $1 $2} -| my_our_paren HASH_IDENT   {check_my_our_paren $1; new_esp ((false, sndfst $1.any), snd $1.any @ [I_hash,   snd $2.any]) $1 $2} -| my_our_paren ARRAY_IDENT  {check_my_our_paren $1; new_esp ((false, sndfst $1.any), snd $1.any @ [I_array,  snd $2.any]) $1 $2} +| MY_OUR PAREN {sp_1($2); new_esp M_special ((true, $1.any), []) $1 $2} +| my_our_paren comma {if fstfst $1.any then die_rule "syntax error"; new_esp M_special ((true, sndfst $1.any), snd $1.any) $1 $2} +| my_our_paren BAREWORD {check_my_our_paren $1; if $2.any <> "undef" then die_rule "scalar expected"; new_esp M_special ((false, sndfst $1.any), snd $1.any @ [I_raw, $2.any]) $1 $2} +| my_our_paren SCALAR_IDENT {check_my_our_paren $1; new_esp M_special ((false, sndfst $1.any), snd $1.any @ [I_scalar, snd $2.any]) $1 $2} +| my_our_paren HASH_IDENT   {check_my_our_paren $1; new_esp M_special ((false, sndfst $1.any), snd $1.any @ [I_hash,   snd $2.any]) $1 $2} +| my_our_paren ARRAY_IDENT  {check_my_our_paren $1; new_esp M_special ((false, sndfst $1.any), snd $1.any @ [I_array,  snd $2.any]) $1 $2}  termdo: /* Things called with "do" */  | DO term %prec UNIOP { die_rule "\"do EXPR\" not allowed" } /* do $filename */ -| DO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_esp (Block $3.any) $1 $4} /* do { code */ +| DO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_esp $3.mcontext (Block $3.any) $1 $4} /* do { code */  bracket_subscript: -| BRACKET expr BRACKET_END {sp_0($1); sp_same $2 $3; check_hash_subscript $2; new_esp (only_one_in_List $2) $1 $3} -| COMPACT_HASH_SUBSCRIPT {sp_0($1); new_esp (to_Raw_string $1) $1 $1} +| BRACKET expr BRACKET_END {sp_0($1); sp_same $2 $3; check_hash_subscript $2; new_esp M_special (only_one_in_List $2) $1 $3} +| COMPACT_HASH_SUBSCRIPT {sp_0($1); new_1esp (to_Raw_string $1) $1 }  variable:  | scalar   %prec PREC_HIGH {$1} @@ -419,9 +424,9 @@ variable:  word:  | bareword { $1 } -| RAW_IDENT { new_esp (to_Ident $1) $1 $1} +| RAW_IDENT { new_1esp (to_Ident $1) $1 } -comma: COMMA {new_esp true $1 $1} | RIGHT_ARROW {sp_p($1); new_esp false $1 $1} +comma: COMMA {new_esp M_special true $1 $1} | RIGHT_ARROW {sp_p($1); new_1esp false $1 }  semi_colon: SEMI_COLON {sp_0($1); $1} @@ -431,24 +436,24 @@ word_or_scalar:  | word_paren {$1}  bareword: -| NEW { new_esp (Ident(None, "new", get_pos $1)) $1 $1} -| FORMAT { new_esp (Ident(None, "format", get_pos $1)) $1 $1} -| BAREWORD { new_esp (Ident(None, $1.any, get_pos $1)) $1 $1} +| NEW { new_1esp (Ident(None, "new", get_pos $1)) $1 } +| FORMAT { new_1esp (Ident(None, "format", get_pos $1)) $1 } +| BAREWORD { new_1esp (Ident(None, $1.any, get_pos $1)) $1 }  word_paren: -| BAREWORD_PAREN { new_esp (Ident(None, $1.any, get_pos $1)) $1 $1} -| RAW_IDENT_PAREN { new_esp (to_Ident $1) $1 $1} -| PO_COMMENT word_paren { po_comment($1); new_esp $2.any $1 $2 } +| BAREWORD_PAREN { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } +| RAW_IDENT_PAREN { new_1esp (to_Ident $1) $1 } +| PO_COMMENT word_paren { po_comment($1); new_esp M_special $2.any $1 $2 } -arraylen: ARRAYLEN_IDENT {new_esp (deref_arraylen (to_Ident $1)) $1 $1} | ARRAYLEN  scalar {sp_0($2); new_esp (deref_arraylen  $2.any ) $1 $1} | ARRAYLEN  bracket_subscript {new_esp (deref_arraylen      $2.any) $1 $2} -scalar:   SCALAR_IDENT   {new_esp (Deref(I_scalar, to_Ident $1)) $1 $1} | DOLLAR    scalar {sp_0($2); new_esp (Deref(I_scalar, $2.any)) $1 $1} | DOLLAR    bracket_subscript {new_esp (deref_raw I_scalar  $2.any) $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); new_esp (Deref(I_scalar, Ref(I_hash, $4.any.expr))) $1 $6} -func:     FUNC_IDENT     {new_esp (Deref(I_func  , to_Ident $1)) $1 $1} | AMPERSAND scalar {sp_0($2); new_esp (Deref(I_func  , $2.any)) $1 $1} | AMPERSAND bracket_subscript {new_esp (deref_raw I_func    $2.any) $1 $2} -array:    ARRAY_IDENT    {new_esp (Deref(I_array , to_Ident $1)) $1 $1} | AT        scalar {sp_0($2); new_esp (Deref(I_array , $2.any)) $1 $1} | AT        bracket_subscript {new_esp (deref_raw I_array   $2.any) $1 $2} -hash:     HASH_IDENT     {new_esp (Deref(I_hash  , to_Ident $1)) $1 $1} | PERCENT   scalar {sp_0($2); new_esp (Deref(I_hash  , $2.any)) $1 $1} | PERCENT   bracket_subscript {new_esp (deref_raw I_hash    $2.any) $1 $2} -star:     STAR_IDENT     {new_esp (Deref(I_star  , to_Ident $1)) $1 $1} | STAR      scalar {sp_0($2); new_esp (Deref(I_star  , $2.any)) $1 $1} | STAR      bracket_subscript {new_esp (deref_raw I_star    $2.any) $1 $2} +arraylen: ARRAYLEN_IDENT {new_esp M_int     (deref_arraylen (to_Ident $1)) $1 $1} | ARRAYLEN  scalar {sp_0($2); new_esp M_int     (deref_arraylen  $2.any ) $1 $1 } | ARRAYLEN  bracket_subscript {new_esp M_int     (deref_arraylen      $2.any) $1 $2} +scalar:   SCALAR_IDENT   {new_esp M_scalar  (Deref(I_scalar, to_Ident $1)) $1 $1} | DOLLAR    scalar {sp_0($2); new_esp M_scalar  (Deref(I_scalar, $2.any)) $1 $1 } | DOLLAR    bracket_subscript {new_esp M_scalar  (deref_raw I_scalar  $2.any) $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); new_esp M_scalar (Deref(I_scalar, Ref(I_hash, $4.any.expr))) $1 $6} +func:     FUNC_IDENT     {new_esp M_unknown (Deref(I_func  , to_Ident $1)) $1 $1} | AMPERSAND scalar {sp_0($2); new_esp M_unknown (Deref(I_func  , $2.any)) $1 $1 } | AMPERSAND bracket_subscript {new_esp M_unknown (deref_raw I_func    $2.any) $1 $2} +array:    ARRAY_IDENT    {new_esp M_array   (Deref(I_array , to_Ident $1)) $1 $1} | AT        scalar {sp_0($2); new_esp M_array   (Deref(I_array , $2.any)) $1 $1 } | AT        bracket_subscript {new_esp M_array   (deref_raw I_array   $2.any) $1 $2} +hash:     HASH_IDENT     {new_esp M_hash    (Deref(I_hash  , to_Ident $1)) $1 $1} | PERCENT   scalar {sp_0($2); new_esp M_hash    (Deref(I_hash  , $2.any)) $1 $1 } | PERCENT   bracket_subscript {new_esp M_hash    (deref_raw I_hash    $2.any) $1 $2} +star:     STAR_IDENT     {new_esp M_unknown (Deref(I_star  , to_Ident $1)) $1 $1} | STAR      scalar {sp_0($2); new_esp M_unknown (Deref(I_star  , $2.any)) $1 $1 } | STAR      bracket_subscript {new_esp M_unknown (deref_raw I_star    $2.any) $1 $2} -expr_or_empty: {default_esp (Block [])} | expr {new_esp $1.any.expr $1 $1} +expr_or_empty: {default_esp (Block [])} | expr {new_1esp $1.any.expr $1 }  %% diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index 2a1bce2..d4c5842 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -13,11 +13,14 @@ let get_pos_end { pos = (_, end_) } = end_  let var_dollar_ pos = Deref(I_scalar, Ident(None, "_", pos))  let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos)) -let new_any any spaces pos = { any = any ; spaces = spaces ; pos = pos } -let new_esp e esp_start esp_end = new_any e esp_start.spaces (raw_pos_range esp_start esp_end) -let new_pesp prio e esp_start esp_end = new_any { priority = prio ; expr = e } esp_start.spaces (raw_pos_range esp_start esp_end) -let default_esp e = new_any e Space_none bpos -let default_pesp prio e = new_any { priority = prio ; expr = e } Space_none bpos +let new_any mcontext any spaces pos = { mcontext = mcontext ; any = any ; spaces = spaces ; pos = pos } +let new_any_ any spaces pos = new_any M_unknown any spaces pos +let new_esp mcontext e esp_start esp_end = new_any mcontext e esp_start.spaces (raw_pos_range esp_start esp_end) +let new_1esp e esp = new_any esp.mcontext e esp.spaces esp.pos +let new_pesp mcontext prio e esp_start esp_end = new_any mcontext { priority = prio ; expr = e } esp_start.spaces (raw_pos_range esp_start esp_end) +let new_1pesp prio e esp = new_any esp.mcontext { priority = prio ; expr = e } esp.spaces esp.pos +let default_esp e = new_any M_unknown e Space_none bpos +let default_pesp prio e = new_any M_unknown { priority = prio ; expr = e } Space_none bpos  let split_name_or_fq_name full_ident =    match split_at2 ':'':' full_ident with @@ -290,28 +293,47 @@ let sp_same esp1 esp2 =    if esp1.spaces <> Space_0 then sp_p esp2    else if esp2.spaces <> Space_0 then sp_p esp1 -let check_word_alone word = -  match word with +let word_alone esp = +  let word = esp.any in +  let mcontext, e = match word with    | Ident(None, f, pos) -> -      (match f with +      let e = match f with        | "length" | "stat" | "lstat" | "chop" | "chomp" | "quotemeta" | "lc" | "lcfirst" | "uc" | "ucfirst" ->  	  Call(Deref(I_func, word), [var_dollar_ pos]) - +	            | "split" -> Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ])        | "shift" -> Call(Deref(I_func, word), [ Deref(I_array,  Ident(None, "_", raw_pos2pos bpos)) ])        | "die"   -> Call(Deref(I_func, word), [ Deref(I_scalar, Ident(None, "@", raw_pos2pos bpos)) ])        | "return" | "eof" | "caller"         | "redo" | "next" | "last" ->   	  Deref(I_func, word) - +	            | "hex" | "ref" ->   	  warn_rule (sprintf "please use \"%s $_\" instead of \"%s\"" f f) ;  	  Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ])        | "time" | "wantarray" | "fork" | "getppid" | "arch" ->   	  warn_rule (sprintf "please use %s() instead of %s" f f) ;  	  Deref(I_func, word) -      | _ -> word) -  | _ -> word +      | _ -> word +      in +      let mcontext = match f with +      | "chop" | "chomp" -> M_none +      | "hex" | "length" | "time" | "fork" | "getppid" -> M_int +      | "eof" | "wantarray" -> M_int +      | "stat" | "lstat" -> M_list +      | "arch" | "quotemeta" | "lc" | "lcfirst" | "uc" | "ucfirst" -> M_string +	     +      | "split" -> M_array +      | "shift" -> M_scalar +      | "die" | "return" | "redo" | "next" | "last" -> M_unknown +      | "caller" -> M_mixed(M_string, M_list) +	     +      | "ref" -> M_ref M_scalar +      | _ -> M_unknown +      in mcontext, e +  | _ -> M_unknown, word +  in +  new_pesp mcontext P_tok e esp esp  let check_parenthesized_first_argexpr word esp =    let want_space = word.[0] = '-' in @@ -412,7 +434,6 @@ let check_unneeded_var_dollar_s esp =    if is_var_dollar_ esp.any.expr then warn esp.pos "\"$_ =~ s/regexp/.../\" can be written \"s/regexp/.../\"" else    if is_var_number_match esp.any.expr then die_with_rawpos esp.pos "do not modify the result of a match (eg: $1)" -let check_MULT_is_x esp = if esp.any <> "x" then die_rule "syntax error"  let check_my esp = if esp.any <> "my" then die_rule "syntax error"  let check_foreach esp = if esp.any = "for"     then warn esp.pos "write \"foreach\" instead of \"for\""  let check_for     esp = if esp.any = "foreach" then warn esp.pos "write \"for\" instead of \"foreach\"" @@ -600,12 +621,12 @@ let cook_call_op op para pos =    | _ ->         call -let to_Call_op op para esp_start esp_end =  +let to_Call_op mcontext op para esp_start esp_end =     let pos = raw_pos_range esp_start esp_end in -  new_any (cook_call_op op para pos) esp_start.spaces pos -let to_Call_op_ prio op para esp_start esp_end =  +  new_any mcontext (cook_call_op op para pos) esp_start.spaces pos +let to_Call_op_ mcontext prio op para esp_start esp_end =     let pos = raw_pos_range esp_start esp_end in -  new_any { priority = prio ; expr = cook_call_op op para pos } esp_start.spaces pos +  new_any mcontext { priority = prio ; expr = cook_call_op op para pos } esp_start.spaces pos  let followed_by_comma pesp true_comma =    if true_comma.any then pesp.any.expr else @@ -749,7 +770,7 @@ let call_one_scalar_para { any = e ; pos = pos } para esp_start esp_end =  	  [var_dollar_ (raw_pos2pos pos)]      | _ -> para    in -  new_pesp P_mul (call(Deref(I_func, Ident(None, e, raw_pos2pos pos)), para)) esp_start esp_end +  new_pesp M_unknown P_mul (call(Deref(I_func, Ident(None, e, raw_pos2pos pos)), para)) esp_start esp_end  let call_op_if_infix left right esp_start esp_end = @@ -760,7 +781,7 @@ let call_op_if_infix left right esp_start esp_end =        warn_rule "\"$foo = ... if !$foo\" can be written \"$foo ||= ...\""    | _ -> ());    let pos = raw_pos_range esp_start esp_end in -  new_any (Call_op("if infix", [ left ; right], raw_pos2pos pos)) esp_start.spaces pos +  new_any M_none (Call_op("if infix", [ left ; right], raw_pos2pos pos)) esp_start.spaces pos  let call_op_unless_infix left right esp_start esp_end =    (match left, right with @@ -775,7 +796,7 @@ let call_op_unless_infix left right esp_start esp_end =        | _ -> ());    | _ -> ());    let pos = raw_pos_range esp_start esp_end in -  new_any (Call_op("unless infix", [ left ; right], raw_pos2pos pos)) esp_start.spaces pos +  new_any M_none (Call_op("unless infix", [ left ; right], raw_pos2pos pos)) esp_start.spaces pos  let (current_lexbuf : Lexing.lexbuf option ref) = ref None @@ -831,3 +852,106 @@ let from_PATTERN_SUBST parse { any = (s1, s2, opts) ; pos = pos } =    [ String(parse_interpolated parse s1, raw_pos2pos pos) ;       String(parse_interpolated parse s2, raw_pos2pos pos) ;       Raw_string(opts, raw_pos2pos pos) ] + + +let rec mcontext2s = function +  | M_none -> "()" + +  | M_int -> "int" +  | M_float -> "float" +  | M_string -> "string" +  | M_ref c -> "ref(" ^ mcontext2s c ^ ")" +  | M_revision -> "revision" +  | M_sub -> "sub" +  | M_scalar -> "scalar" + +  | M_list -> "list" +  | M_array -> "array" +  | M_hash -> "hash" + +  | M_special -> "special" +  | M_unknown -> "unknown" +  | M_mixed(a, b) -> mcontext2s a ^ " | " ^ mcontext2s b + +let mcontext_is_scalar = function +  | M_int | M_float | M_string | M_ref _ | M_revision +  | M_scalar | M_array -> true +  | _ -> false + +let rec mcontext_lower c1 c2 = +  match c1, c2 with +  | M_special, _ | _, M_special -> internal_error "M_special in mcontext_compare" + +  | M_array, M_array | M_array, M_int | M_array, M_float | M_array, M_scalar | M_array, M_list +  | M_hash, M_hash | M_hash, M_scalar | M_hash, M_list + +  | M_int, M_int | M_int, M_float | M_int, M_string | M_int, M_scalar | M_int, M_list +  | M_float, M_float | M_float, M_string | M_float, M_scalar | M_float, M_list +  | M_ref _, M_scalar | M_ref _, M_list +  | M_string, M_string | M_string, M_scalar | M_string, M_list +  | M_revision, M_revision | M_revision, M_scalar | M_revision, M_list +  | M_scalar, M_scalar | M_scalar, M_list + +  | M_list, M_list +  | M_none, M_none +  | M_sub, M_sub + +  | _, M_unknown + +    -> true + +  | M_ref a, M_ref b -> mcontext_lower a b +  | M_mixed(c1, c2), M_mixed(a, b) -> mcontext_lower c1 a && mcontext_lower c2 b || mcontext_lower c2 a && mcontext_lower c1 b +  | c, M_mixed(a, b) -> mcontext_lower c a || mcontext_lower c b + +  | _ -> false + +let mcontext_merge c1 c2 = +  if mcontext_lower c1 c2 then c2 else +  if mcontext_lower c2 c1 then c1 else +  match c1, c2 with +  | M_unknown, _ | _, M_unknown -> internal_error "mcontext_merge1" +  | M_mixed _, _ | _, M_mixed _ -> internal_error "TODO: complex mcontext_merge" +  | _ ->  +      if mcontext_is_scalar c1 && mcontext_is_scalar c2  +      then M_scalar  +      else M_mixed(c1, c2) +let mcontext_lmerge = function +  | [] -> internal_error "mcontext_lmerge" +  | e :: l -> List.fold_left mcontext_merge e l + +let mcontext_lmaybe esp = if esp.any = [] then [] else [esp.mcontext] + +let mcontext_check_raw wanted_mcontext esp f_lower f_greater f_err = +  if mcontext_lower esp.mcontext wanted_mcontext then +    f_lower() +  else if mcontext_lower wanted_mcontext esp.mcontext then +    f_greater() +  else  +    (warn_rule (sprintf "context %s is not compatible with context %s" (mcontext2s esp.mcontext) (mcontext2s wanted_mcontext));  +     f_err()) + +let mcontext_symops wanted_mcontext esp1 esp2 = +  mcontext_check_raw wanted_mcontext esp1  +    (fun () -> +      mcontext_check_raw wanted_mcontext esp2 +	(fun () -> +	  match mcontext_merge esp1.mcontext esp2.mcontext with +	  | M_array when mcontext_is_scalar wanted_mcontext -> M_int (* don't allow @a + @b to return M_array *) +	  | r -> r) +	(fun () -> mcontext_merge esp1.mcontext wanted_mcontext) +	(fun () -> wanted_mcontext)) +    (fun () -> +      mcontext_check_raw wanted_mcontext esp2 +	(fun () -> mcontext_merge wanted_mcontext esp2.mcontext) +	(fun () -> wanted_mcontext) +	(fun () -> wanted_mcontext)) +    (fun () -> wanted_mcontext) + +let mcontext_check wanted_mcontext esp = +  mcontext_check_raw wanted_mcontext esp (fun () -> ()) (fun () -> ()) (fun () -> ()) + +let mcontext_unop wanted_mcontext esp = mcontext_check wanted_mcontext esp ; wanted_mcontext + +let mcontext_check_non_none esp = +  if esp.mcontext = M_none then warn_rule "() context not accepted here" diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli index 7d8f7a3..9334d58 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -9,16 +9,25 @@ val get_pos_start : 'a Types.any_spaces_pos -> int  val get_pos_end : 'a Types.any_spaces_pos -> int  val var_dollar_ : Types.pos -> Types.fromparser  val var_STDOUT : Types.fromparser -val new_any : 'a -> Types.spaces -> int * int -> 'a Types.any_spaces_pos +val new_any : +  Types.maybe_context -> +  'a -> Types.spaces -> int * int -> 'a Types.any_spaces_pos +val new_any_ : 'a -> Types.spaces -> int * int -> 'a Types.any_spaces_pos  val new_esp : +  Types.maybe_context ->    'a ->    'b Types.any_spaces_pos ->    'c Types.any_spaces_pos -> 'a Types.any_spaces_pos +val new_1esp : 'a -> 'b Types.any_spaces_pos -> 'a Types.any_spaces_pos  val new_pesp : +  Types.maybe_context ->    Types.priority ->    'a ->    'b Types.any_spaces_pos ->    'c Types.any_spaces_pos -> 'a Types.prio_anyexpr Types.any_spaces_pos +val new_1pesp : +  Types.priority -> +  'a -> 'b Types.any_spaces_pos -> 'a Types.prio_anyexpr Types.any_spaces_pos  val default_esp : 'a -> 'a Types.any_spaces_pos  val default_pesp :    Types.priority -> 'a -> 'a Types.prio_anyexpr Types.any_spaces_pos @@ -74,7 +83,9 @@ val sp_n : 'a Types.any_spaces_pos -> unit  val sp_p : 'a Types.any_spaces_pos -> unit  val sp_cr : 'a Types.any_spaces_pos -> unit  val sp_same : 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> unit -val check_word_alone : Types.fromparser -> Types.fromparser +val word_alone : +  Types.fromparser Types.any_spaces_pos -> +  Types.fromparser Types.prio_anyexpr Types.any_spaces_pos  val check_parenthesized_first_argexpr :    string ->    Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit @@ -98,7 +109,6 @@ val check_unneeded_var_dollar_not :    Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit  val check_unneeded_var_dollar_s :    Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_MULT_is_x : string Types.any_spaces_pos -> unit  val check_my : string Types.any_spaces_pos -> unit  val check_foreach : string Types.any_spaces_pos -> unit  val check_for : string Types.any_spaces_pos -> unit @@ -143,11 +153,13 @@ val anonymous_sub :  val cook_call_op :    string -> Types.fromparser list -> int * int -> Types.fromparser  val to_Call_op : +  Types.maybe_context ->    string ->    Types.fromparser list ->    'a Types.any_spaces_pos ->    'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos  val to_Call_op_ : +  Types.maybe_context ->    Types.priority ->    string ->    Types.fromparser list -> @@ -204,3 +216,22 @@ val from_PATTERN_SUBST :    ((string * ((int * int) * 'a) list) list *     (string * ((int * int) * 'a) list) list * string)    Types.any_spaces_pos -> Types.fromparser list +val mcontext2s : Types.maybe_context -> string +val mcontext_is_scalar : Types.maybe_context -> bool +val mcontext_lower : Types.maybe_context -> Types.maybe_context -> bool +val mcontext_merge : +  Types.maybe_context -> Types.maybe_context -> Types.maybe_context +val mcontext_lmerge : Types.maybe_context list -> Types.maybe_context +val mcontext_lmaybe : +  'a list Types.any_spaces_pos -> Types.maybe_context list +val mcontext_check_raw : +  Types.maybe_context -> +  'a Types.any_spaces_pos -> +  (unit -> 'b) -> (unit -> 'b) -> (unit -> 'b) -> 'b +val mcontext_symops : +  Types.maybe_context -> +  'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> Types.maybe_context +val mcontext_check : Types.maybe_context -> 'a Types.any_spaces_pos -> unit +val mcontext_unop : +  Types.maybe_context -> 'a Types.any_spaces_pos -> Types.maybe_context +val mcontext_check_non_none : 'a Types.any_spaces_pos -> unit diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli index 6f49cd9..c8fbeaa 100644 --- a/perl_checker.src/types.mli +++ b/perl_checker.src/types.mli @@ -13,6 +13,20 @@ type spaces =  type context = I_scalar | I_hash | I_array | I_func | I_raw | I_star +type maybe_context = +  | M_none + +  | M_int | M_float | M_string | M_ref of maybe_context | M_revision | M_sub +  | M_scalar + +  | M_list +  | M_array +  | M_hash + +  | M_special +  | M_unknown +  | M_mixed of maybe_context * maybe_context +  type fromparser =      | Undef     | Ident of string option * string * pos @@ -72,6 +86,7 @@ type 'a any_spaces_pos = {      any : 'a ;      spaces : spaces ;      pos : int * int ; +    mcontext : maybe_context ;    }  type 'a prio_anyexpr = {  | 
