From 659ced82c2465f81c3f14a1fa601d7df9ce2d2da Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Mon, 18 Nov 2002 14:26:44 +0000 Subject: *** empty log message *** --- perl_checker.src/lexer.mll | 8 ++++---- perl_checker.src/parser.mly | 23 ++++++++++++----------- perl_checker.src/parser_helper.ml | 12 +++++++++++- perl_checker.src/parser_helper.mli | 3 +++ 4 files changed, 30 insertions(+), 16 deletions(-) diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index 4e19647..07aa48a 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -37,7 +37,7 @@ 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 | DEFINED of raw_pos | PATTERN_MATCH of raw_pos | PATTERN_MATCH_NOT of raw_pos | MULT of (string * 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) | 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) | 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) @@ -115,6 +115,7 @@ let rec concat_spaces get_token lexbuf = | MULT(s, pos) -> Parser.MULT(s, (spaces, pos)) | BIT_SHIFT(s, pos) -> Parser.BIT_SHIFT(s, (spaces, pos)) | PLUS(s, pos) -> Parser.PLUS(s, (spaces, pos)) + | ONE_SCALAR_PARA(s, pos) -> Parser.ONE_SCALAR_PARA(s, (spaces, pos)) | EOF (pos) -> Parser.EOF ((), (spaces, pos)) | IF (pos) -> Parser.IF ((), (spaces, pos)) @@ -171,7 +172,6 @@ let rec concat_spaces get_token lexbuf = | AND (pos) -> Parser.AND ((), (spaces, pos)) | OR (pos) -> Parser.OR ((), (spaces, pos)) | XOR (pos) -> Parser.XOR ((), (spaces, pos)) - | DEFINED (pos) -> Parser.DEFINED ((), (spaces, pos)) | SPACE _ | CR -> internal_error "raw_token_to_token" @@ -358,7 +358,7 @@ rule token = parse | "print" { PRINT(lexeme lexbuf, pos lexbuf) } | "new" { NEW(pos lexbuf) } | "format" { let _ = here_doc_next_line "." false in FORMAT(pos lexbuf) } -| "defined" { DEFINED(pos lexbuf) } +| "defined" { ONE_SCALAR_PARA(lexeme lexbuf, pos lexbuf) } | "split" | "grep" { (* ok_for_match! *) BAREWORD(lexeme lexbuf, pos lexbuf) } @@ -517,7 +517,7 @@ rule token = parse | ident ":" { LABEL(lexeme lexbuf, pos lexbuf) } -| '-' [ 'a'-'z' 'A'-'Z' ] [ ' ' '(' ] { putback lexbuf 1; BAREWORD(lexeme lexbuf, pos lexbuf) } +| '-' [ 'a'-'z' 'A'-'Z' ] [ ' ' '(' ] { putback lexbuf 1; ONE_SCALAR_PARA(lexeme lexbuf, pos lexbuf) } | ['0'-'9'] ['0'-'9' '_']* ('.' ['0'-'9'] ['0'-'9' '_']*)+ | 'v' ['0'-'9'] ['0'-'9' '_']* ('.' ['0'-'9'] ['0'-'9' '_']*)* diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index 22911cb..8793b9e 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -8,8 +8,8 @@ %} -%token EOF DEFINED -%token NUM STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PRINT_TO_STAR PRINT_TO_SCALAR +%token EOF +%token NUM STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PRINT_TO_STAR PRINT_TO_SCALAR ONE_SCALAR_PARA %token COMMAND_STRING QUOTEWORDS COMPACT_HASH_SUBSCRIPT %token <(string * Types.raw_pos) ref * (Types.spaces * Types.raw_pos)> HERE_DOC @@ -186,7 +186,7 @@ argexpr: /* Expressions are a list of terms joined by commas */ /********************************************************************************/ term: -| term ASSIGN term {let pri = P_assign in call_op(op_p pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), pos_range $1 $3} +| term ASSIGN term {let pri = P_assign in call_op(op_p pri (fst $2) $2, $3, [sndfst $1; prio_lo_after pri $3]), pos_range $1 $3} | term PLUS term {let pri = P_add in call_op(op pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), pos_range $1 $3} | term COMPARE_OP term {let pri = P_cmp in call_op(op_p pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), pos_range $1 $3} | term LT term {let pri = P_cmp in call_op(op_p pri "<" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), pos_range $1 $3} @@ -219,10 +219,10 @@ term: | term PATTERN_MATCH_NOT STRING {die_with_pos (sndsnd $3) "use a regexp, not a string"} -| term QUESTION_MARK term COLON term {sp_n($2); sp_p($3); sp_p($4); sp_p($5); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; prio_lo_after P_ternary $5])), pos_range $1 $5} -| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; sndfst $6])), pos_range $1 $7} -| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; sndfst $4; prio_lo_after P_ternary $7])), pos_range $1 $7} -| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; sndfst $4; sndfst $8])), pos_range $1 $9} +| term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; prio_lo_after P_ternary $5])), pos_range $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); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; sndfst $6])), pos_range $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); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; sndfst $4; prio_lo_after P_ternary $7])), pos_range $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); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; sndfst $4; sndfst $8])), pos_range $1 $9} /* Unary operators and terms */ @@ -235,10 +235,11 @@ term: | term DECR {sp_0($2); (P_tight, Call_op("-- post", [sndfst $1])), pos_range $1 $2} | NOT argexpr {(P_and, Call_op("not", sndfst $2)), pos_range $1 $2} -| DEFINED variable {(P_expr, Call(Ident(None, "defined", get_pos $1), [fst $2])), pos_range $1 $2} -| DEFINED subscripted {(P_expr, Call(Ident(None, "defined", get_pos $1), [fst $2])), pos_range $1 $2} -| DEFINED parenthesized {(P_expr, Call(Ident(None, "defined", get_pos $1), sndfst $2)), pos_range $1 $2} -| DEFINED word_paren parenthesized {(P_expr, Call(Ident(None, "defined", get_pos $1), [Call(fst $2, sndfst $3)])), pos_range $1 $3} +| ONE_SCALAR_PARA STRING {call_one_scalar_para $1 [to_String $2], pos_range $1 $2} +| ONE_SCALAR_PARA variable {call_one_scalar_para $1 [fst $2], pos_range $1 $2} +| ONE_SCALAR_PARA subscripted {call_one_scalar_para $1 [fst $2], pos_range $1 $2} +| ONE_SCALAR_PARA parenthesized {call_one_scalar_para $1 (sndfst $2), pos_range $1 $2} +| ONE_SCALAR_PARA word_paren parenthesized {call_one_scalar_para $1 [Call(fst $2, sndfst $3)], pos_range $1 $3} /* Constructors for anonymous data */ diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index 075e110..ebd5cfd 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -105,7 +105,6 @@ let prio_lo pri_out ((pri_in, e), (_, pos)) = | P_paren (P_paren_wanted _) -> () | P_paren pri_in' -> if pri_in' <> pri_out && - pri_out <> P_assign && prio_less(pri_in', pri_out) && not_complex (un_parenthesize e) then warn pos "unneeded parentheses" | _ -> ()) @@ -269,6 +268,17 @@ let call(e, para) = | [ Ident _ ] -> () | [ String _ ] -> () | _ -> die_rule "use either \"require PACKAGE\" or \"require 'PACKAGE.pm'\"") + | Ident(None, "N", _) -> + (match para with + | [List(String _ :: _)] -> () + | _ -> die_rule "N() must be used with a string") | _ -> ()); Call(e, para) +let call_one_scalar_para (e, (_, pos)) para = + let pri = + match e with + | "defined" -> P_expr + | _ -> P_add + in + pri, Call(Ident(None, e, raw_pos2pos pos), para) diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli index 7c68b7d..db59ee5 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -82,3 +82,6 @@ val to_List : Types.fromparser list -> Types.fromparser val sub_declaration : Types.fromparser * string -> Types.fromparser list -> Types.fromparser val call : Types.fromparser * Types.fromparser list -> Types.fromparser +val call_one_scalar_para : + string * ('a * (int * int)) -> + Types.fromparser list -> Types.priority * Types.fromparser -- cgit v1.2.1