*** empty log message ***

10 files changed, 606 insertions, 325 deletions

diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml
index 64e123d..a4d0789 100644
--- a/perl_checker.src/common.ml
+++ b/perl_checker.src/common.ml
@@ -643,12 +643,24 @@ let int_sort l = sort (fun a b -> a - b) l
 let str_begins_with s prefix =
   String.sub s 0 (min (String.length s) (String.length prefix)) = prefix
 
-let rec str_contains s1 s2 =
-  match s1 with
-  | "" -> false
-  | _ -> 
-      if str_begins_with s1 s2 then true
-      else str_contains (String.sub s1 1 (String.length s1 - 1)) s2
+let rec strstr s subs =
+  let len_s, len_subs = String.length s, String.length subs in
+  let rec rec_ i =
+    let i' = String.index_from s i subs.[0] in
+    if i' + len_subs <= len_s then
+      if String.sub s i' len_subs = subs then
+	i'
+      else
+	rec_ (i' + 1)
+    else
+      raise Not_found
+  in
+  rec_ 0
+
+let str_contains s subs =
+  try
+    let _ = strstr s subs in true
+  with Not_found -> false
 
 let str_ends_with s suffix =
   let len = min (String.length s) (String.length suffix) in
@@ -686,6 +698,29 @@ let rec explode_string = function
 let is_uppercase c = Char.lowercase c <> c
 let is_lowercase c = Char.uppercase c <> c
 
+let char_is_alphanumerical c =
+  let i = Char.code c in
+  Char.code 'a' <= i && i <= Char.code 'z' ||
+  Char.code 'A' <= i && i <= Char.code 'Z' ||
+  Char.code '0' <= i && i <= Char.code '9'
+
+let char_is_alphanumerical_ c =
+  let i = Char.code c in
+  Char.code 'a' <= i && i <= Char.code 'z' ||
+  Char.code 'A' <= i && i <= Char.code 'Z' ||
+  Char.code '0' <= i && i <= Char.code '9' || c = '_'
+
+let char_is_alpha c =
+  let i = Char.code c in
+  Char.code 'a' <= i && i <= Char.code 'z' ||
+  Char.code 'A' <= i && i <= Char.code 'Z'
+
+let rec string_forall_with f i s =
+  try
+    f s.[i] && string_forall_with f (i+1) s
+  with Invalid_argument _ -> true
+
+
 let starts_with_non_lowercase s = s <> "" && s.[0] <> '_' && not (is_lowercase s.[0])
 
 let rec fold_lines f init chan =
diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli
index 397af3c..cfb4780 100644
--- a/perl_checker.src/common.mli
+++ b/perl_checker.src/common.mli
@@ -175,6 +175,7 @@ val graph_sort_by :
   ('a * 'a list) list -> (('a * 'a list) list, 'a * 'a) or_option
 val int_sort : int list -> int list
 val str_begins_with : string -> string -> bool
+val strstr : string -> string -> int
 val str_contains : string -> string -> bool
 val str_ends_with : string -> string -> bool
 val chop : string -> string
@@ -189,6 +190,10 @@ val non_rindex : string -> char -> int
 val explode_string : string -> char list
 val is_uppercase : char -> bool
 val is_lowercase : char -> bool
+val char_is_alphanumerical : char -> bool
+val char_is_alphanumerical_ : char -> bool
+val char_is_alpha : char -> bool
+val string_forall_with : (char -> bool) -> int -> string -> bool
 val starts_with_non_lowercase : string -> bool
 val fold_lines : ('a -> string -> 'a) -> 'a -> in_channel -> 'a
 val readlines : in_channel -> string list
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll
index 1e1c875..b295400 100644
--- a/perl_checker.src/lexer.mll
+++ b/perl_checker.src/lexer.mll
@@ -51,14 +51,14 @@ type raw_token =
 
 and raw_interpolated_string = (string * raw_token list) list
 
-let rec concat_bareword_paren = function
+let rec concat_bareword_paren accu = function
   | PRINT(s, pos1) :: PAREN(pos2) :: l
   | BAREWORD(s, pos1) :: PAREN(pos2) :: l ->
-      BAREWORD_PAREN(s, pos1) :: PAREN(pos2) :: concat_bareword_paren l
+      concat_bareword_paren (PAREN(pos2) :: BAREWORD_PAREN(s, pos1) :: accu) l
   | RAW_IDENT(kind, ident, pos1) :: PAREN(pos2) :: l -> 
-      RAW_IDENT_PAREN(kind, ident, pos1) :: PAREN(pos2) :: concat_bareword_paren l
-  | [] -> []
-  | e :: l -> e :: concat_bareword_paren l
+      concat_bareword_paren (PAREN(pos2) :: RAW_IDENT_PAREN(kind, ident, pos1) :: accu) l
+  | [] -> List.rev accu
+  | e :: l -> concat_bareword_paren (e :: accu) l
 
 let rec raw_token_to_pos_and_token spaces = function
   | NUM(s, pos) -> pos, Parser.NUM(s, (spaces, pos))
@@ -188,7 +188,7 @@ let rec lexbuf2list accu t lexbuf =
 
 let get_token token lexbuf = 
   let tokens = lexbuf2list [] token lexbuf in
-  let tokens = concat_bareword_paren tokens in
+  let tokens = concat_bareword_paren [] tokens in
   let tokens = concat_spaces Space_0 tokens in
   tokens
 
@@ -268,7 +268,7 @@ let string_interpolate token pre lexbuf =
    let local_lexbuf = Lexing.from_string (pre ^ s ^ " ") in (* add a space to help tokenizing "xxx$$" *)
    local_lexbuf.lex_abs_pos <- lexeme_start lexbuf ;
    let l = lexbuf2list [] token local_lexbuf in
-   let l = concat_bareword_paren l in
+   let l = concat_bareword_paren [] l in
    next_interpolated l; 
    (Stack.pop next_rule) lexbuf
 
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index 90eab90..7d7948a 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly
@@ -115,8 +115,8 @@ line:
 | BRACKET lines BRACKET_END {check_block_sub $2 $3; [Block(fst $2)], sp_pos_range $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; Call_op("if",     prio_lo P_loose $3 :: Block(fst $6) :: fst $8 @ fst $9), sp_pos_range $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; Call_op("unless", prio_lo P_loose $3 :: Block(fst $6) :: fst $8 @ fst $9), sp_pos_range $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); check_block_sub $6 $7; to_Call_op("if",     prio_lo P_loose $3 :: Block(fst $6) :: fst $8 @ fst $9) (sp_pos_range $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(fst $6) :: fst $8 @ fst $9) (sp_pos_range $1 $9)}
 
 elsif:
 |  {[], (Space_none, bpos)}
@@ -127,12 +127,12 @@ else_:
 | ELSE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_sub $3 $4; [Block(fst $3)], sp_pos_range $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; Call_op("while", [ prio_lo P_loose $3; Block(fst $6) ]), sp_pos_range $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; Call_op("until", [ prio_lo P_loose $3; Block(fst $6) ]), sp_pos_range $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; Call_op("for", [ fst $3; fst $5; fst $7; Block(fst $10) ]), sp_pos_range $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); check_block_sub $6 $7; to_Call_op("while", [ prio_lo P_loose $3; Block(fst $6) ]) (sp_pos_range $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(fst $6) ]) (sp_pos_range $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", [ fst $3; fst $5; fst $7; Block(fst $10) ]) (sp_pos_range $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_foreach($1); Call_op("foreach", [ prio_lo P_loose $3; Block(fst $6) ]), sp_pos_range $1 $8}
-| for_my lines BRACKET_END cont {check_block_sub $2 $3; Call_op("foreach my", fst $1 @ [ Block(fst $2) ]), sp_pos_range $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); check_block_sub $6 $7; check_for_foreach $1 $3; to_Call_op("foreach", [ prio_lo P_loose $3; Block(fst $6) ]) (sp_pos_range $1 $8)}
+| for_my lines BRACKET_END cont {check_block_sub $2 $3; to_Call_op("foreach my", fst $1 @ [ Block(fst $2) ]) (sp_pos_range $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); [ My_our(fst $2, [I_scalar, sndfst $3], get_pos $3); prio_lo P_loose $5 ], sp_pos_range $1 $7}
@@ -144,11 +144,11 @@ cont: /* Continue blocks */
 
 sideff: /* An expression which may have a side-effect */
 | expr  {sndfst $1, snd $1}
-| expr   IF    expr {sp_p($2); sp_p($3);                    Call_op("if infix"    , [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), sp_pos_range $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 ]), sp_pos_range $1 $3}
-| expr  WHILE  expr {sp_p($2); sp_p($3);                    Call_op("while infix" , [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), sp_pos_range $1 $3}
-| expr  UNTIL  expr {sp_p($2); sp_p($3);                    Call_op("until infix" , [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), sp_pos_range $1 $3}
-| expr  FOR    expr {sp_p($2); sp_p($3); check_foreach($2); Call_op("for infix"   , [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), sp_pos_range $1 $3}
+| expr   IF    expr {sp_p($2); sp_p($3);                    call_op_if_infix         (prio_lo P_loose $1) (prio_lo P_loose $3)   (sp_pos_range $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)   (sp_pos_range $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 ]) (sp_pos_range $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 ]) (sp_pos_range $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 ]) (sp_pos_range $1 $3)}
 
 decl:
 | FORMAT BAREWORD ASSIGN {Too_complex, sp_pos_range $1 $3}
@@ -185,8 +185,8 @@ listexpr: /* Basic list expressions */
 | argexpr %prec PREC_LOW {$1}
 
 expr: /* Ordinary expressions; logical combinations */
-| expr AND expr {sp_p($2); sp_p($3); (P_and, Call_op("and", [ prio_lo P_and $1; prio_lo_after P_and $3 ])), sp_pos_range $1 $3}
-| expr OR  expr {sp_p($2); sp_p($3); (P_or,  Call_op("or",  [ prio_lo P_or  $1; prio_lo_after P_or  $3 ])), sp_pos_range $1 $3}
+| 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 ]) (sp_pos_range $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 ]) (sp_pos_range $1 $3)}
 | argexpr %prec PREC_LOW {(fstfst $1, List(sndfst $1)), snd $1}
 
 argexpr: /* Expressions are a list of terms joined by commas */
@@ -197,31 +197,32 @@ argexpr: /* Expressions are a list of terms joined by commas */
 
 /********************************************************************************/
 term:
-| term ASSIGN     term {let pri = P_assign    in call_op(op   pri (fst $2) $2, $3, [sndfst      $1; prio_lo_after pri $3]), sp_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]), sp_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]), sp_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]), sp_pos_range $1 $3}
-| term GT         term {let pri = P_cmp       in call_op(op_p pri ">"      $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term EQ_OP      term {let pri = P_eq        in call_op(op_p pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term POWER      term {let pri = P_tight     in call_op(op   pri "**"     $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term BIT_AND    term {let pri = P_expr      in call_op(op_p pri "&"      $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term BIT_OR     term {let pri = P_expr      in call_op(op   pri "|"      $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term BIT_XOR    term {let pri = P_expr      in call_op(op_p pri "^"      $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term AND_TIGHT  term {let pri = P_tight_and in call_op(op_p pri "&&"     $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term OR_TIGHT   term {let pri = P_tight_or  in call_op(op_p pri "||"     $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term MULT       term {let pri = P_mul       in call_op(op   pri (fst $2) $2, $3, [prio_lo_concat $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term DOTDOT     term {let pri = P_paren_wanted P_expr  in call_op(op   pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term BIT_SHIFT  term {let pri = P_paren_wanted P_tight in call_op(op   pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-| term XOR        term {let pri = P_paren_wanted P_expr  in call_op(op_p pri "xor"    $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), sp_pos_range $1 $3}
-
-| term ASSIGN     BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op(op_p P_assign (fst $2) $2, $3, [prio_lo P_assign    $1; Ref(I_hash, sndfst $4)]), sp_pos_range $1 $5}
-| term AND_TIGHT  BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op(op_p P_tight_and "&&"  $2, $3, [prio_lo P_assign    $1; Ref(I_hash, sndfst $4)]), sp_pos_range $1 $5}
-| term OR_TIGHT   BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op(op_p P_tight_or  "||"  $2, $3, [prio_lo P_assign    $1; Ref(I_hash, sndfst $4)]), sp_pos_range $1 $5}
-
-
-| term PATTERN_MATCH     PATTERN   {sp_n($2); sp_p($3); (P_expr, Call_op("m//",  sndfst $1 :: from_PATTERN $3)), sp_pos_range $1 $3}
-| term PATTERN_MATCH_NOT PATTERN   {sp_n($2); sp_p($3); (P_expr, Call_op("!m//", sndfst $1 :: from_PATTERN $3)), sp_pos_range $1 $3}
-| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); (P_expr, Call_op("s///", sndfst $1 :: from_PATTERN_SUBST $3)), sp_pos_range $1 $3}
+| term ASSIGN     term {let pri = P_assign    in call_op_(op   pri (fst $2) $2, $3, [sndfst      $1; prio_lo_after pri $3]) (sp_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]) (sp_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]) (sp_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]) (sp_pos_range $1 $3)}
+| term GT         term {let pri = P_cmp       in call_op_(op_p pri ">"      $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term EQ_OP      term {let pri = P_eq        in call_op_(op_p pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term POWER      term {let pri = P_tight     in call_op_(op   pri "**"     $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term BIT_AND    term {let pri = P_expr      in call_op_(op_p pri "&"      $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term BIT_OR     term {let pri = P_expr      in call_op_(op   pri "|"      $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term BIT_XOR    term {let pri = P_expr      in call_op_(op_p pri "^"      $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term AND_TIGHT  term {let pri = P_tight_and in call_op_(op_p pri "&&"     $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term OR_TIGHT   term {let pri = P_tight_or  in call_op_(op_p pri "||"     $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term MULT       term {let pri = P_mul       in call_op_(op   pri (fst $2) $2, $3, [prio_lo_concat $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term DOTDOT     term {let pri = P_paren_wanted P_expr  in call_op_(op   pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term BIT_SHIFT  term {let pri = P_paren_wanted P_tight in call_op_(op   pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+| term XOR        term {let pri = P_paren_wanted P_expr  in call_op_(op_p pri "xor"    $2, $3, [prio_lo pri $1; prio_lo_after pri $3]) (sp_pos_range $1 $3)}
+
+| term ASSIGN     BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op_(op_p P_assign (fst $2) $2, $3, [prio_lo P_assign    $1; Ref(I_hash, sndfst $4)]) (sp_pos_range $1 $5)}
+| term AND_TIGHT  BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op_(op_p P_tight_and "&&"  $2, $3, [prio_lo P_assign    $1; Ref(I_hash, sndfst $4)]) (sp_pos_range $1 $5)}
+| term OR_TIGHT   BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op_(op_p P_tight_or  "||"  $2, $3, [prio_lo P_assign    $1; Ref(I_hash, sndfst $4)]) (sp_pos_range $1 $5)}
+
+
+| term PATTERN_MATCH     PATTERN   {sp_n($2); sp_p($3); check_unneeded_var_dollar_   ($1); to_Call_op_(P_expr, "m//",  sndfst $1 :: from_PATTERN $3) (sp_pos_range $1 $3)}
+| term PATTERN_MATCH_NOT PATTERN   {sp_n($2); sp_p($3); check_unneeded_var_dollar_s  ($1); to_Call_op_(P_expr, "!m//", sndfst $1 :: from_PATTERN $3) (sp_pos_range $1 $3)}
+| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_not($1); to_Call_op_(P_expr, "s///", sndfst $1 :: from_PATTERN_SUBST $3) (sp_pos_range $1 $3)}
+| term PATTERN_MATCH_NOT PATTERN_SUBST {die_with_rawpos (sndsnd $2) "use =~ instead of !~ and negate the return value"}
 
 | term PATTERN_MATCH     scalar { (P_expr, Too_complex), sp_pos_range $1 $3}
 | term PATTERN_MATCH_NOT scalar { (P_expr, Too_complex), sp_pos_range $1 $3}
@@ -232,28 +233,28 @@ term:
 | term PATTERN_MATCH_NOT STRING {die_with_rawpos (sndsnd $3) "use a regexp, not a string"}
 
 
-| 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])), sp_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])), sp_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])), sp_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])), sp_pos_range $1 $9}
+| term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_(P_ternary, "?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; prio_lo_after P_ternary $5]) (sp_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); to_Call_op_(P_ternary, "?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; sndfst $6]) (sp_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); to_Call_op_(P_ternary, "?:", [ prio_lo P_ternary $1 ; sndfst $4; prio_lo_after P_ternary $7]) (sp_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); to_Call_op_(P_ternary, "?:", [ prio_lo P_ternary $1 ; sndfst $4; sndfst $8]) (sp_pos_range $1 $9)}
 
 
 /* Unary operators and terms */
-| PLUS term %prec UNARY_MINUS {if fst $1 <> "-" then die_rule "syntax error"; sp_0($2); (P_tight, Call_op("- unary", [sndfst $2])), sp_pos_range $1 $2}
-| TIGHT_NOT term {(P_tight, Call_op("not", [sndfst $2])), sp_pos_range $1 $2}
-| BIT_NEG term {(P_expr, Call_op("~", [sndfst $2])), sp_pos_range $1 $2}
-| INCR term    {sp_0($2); (P_tight, Call_op("++", [sndfst $2])), sp_pos_range $1 $2}
-| DECR term    {sp_0($2); (P_tight, Call_op("--", [sndfst $2])), sp_pos_range $1 $2}
-| term INCR    {sp_0($2); (P_tight, Call_op("++ post", [sndfst $1])), sp_pos_range $1 $2}
-| term DECR    {sp_0($2); (P_tight, Call_op("-- post", [sndfst $1])), sp_pos_range $1 $2}
-| NOT argexpr  {(P_and, Call_op("not", sndfst $2)), sp_pos_range $1 $2}
+| PLUS term %prec UNARY_MINUS {if fst $1 <> "-" then die_rule "syntax error"; sp_0($2); to_Call_op_(P_tight, "- unary", [sndfst $2]) (sp_pos_range $1 $2)}
+| TIGHT_NOT term {to_Call_op_(P_tight, "not", [sndfst $2]) (sp_pos_range $1 $2)}
+| BIT_NEG term {to_Call_op_(P_expr, "~", [sndfst $2]) (sp_pos_range $1 $2)}
+| INCR term    {sp_0($2); to_Call_op_(P_tight, "++", [sndfst $2]) (sp_pos_range $1 $2)}
+| DECR term    {sp_0($2); to_Call_op_(P_tight, "--", [sndfst $2]) (sp_pos_range $1 $2)}
+| term INCR    {sp_0($2); to_Call_op_(P_tight, "++ post", [sndfst $1]) (sp_pos_range $1 $2)}
+| term DECR    {sp_0($2); to_Call_op_(P_tight, "-- post", [sndfst $1]) (sp_pos_range $1 $2)}
+| NOT argexpr  {to_Call_op_(P_and, "not", sndfst $2) (sp_pos_range $1 $2)}
 
 | ONE_SCALAR_PARA RAW_STRING               {call_one_scalar_para $1 [to_Raw_string $2], sp_pos_range $1 $2}
-| ONE_SCALAR_PARA STRING                   {call_one_scalar_para $1 [to_String $2], sp_pos_range $1 $2}
+| ONE_SCALAR_PARA STRING                   {call_one_scalar_para $1 [to_String true $2], sp_pos_range $1 $2}
 | ONE_SCALAR_PARA variable                 {call_one_scalar_para $1 [fst $2], sp_pos_range $1 $2}
 | ONE_SCALAR_PARA restricted_subscripted   {call_one_scalar_para $1 [fst $2], sp_pos_range $1 $2}
 | ONE_SCALAR_PARA parenthesized            {call_one_scalar_para $1 (sndfst $2), sp_pos_range $1 $2}
-| ONE_SCALAR_PARA word_paren parenthesized {call_one_scalar_para $1 [Call(Deref(I_func, fst $2), sndfst $3)], sp_pos_range $1 $3}
+| ONE_SCALAR_PARA word_paren parenthesized {call_one_scalar_para $1 [call(Deref(I_func, fst $2), sndfst $3)], sp_pos_range $1 $3}
 
 /* Constructors for anonymous data */
 
@@ -273,40 +274,40 @@ term:
 | LOCAL term    %prec UNIOP {sp_n($2); (P_expr, to_Local $2), sp_pos_range $1 $2}
 
 | parenthesized {(fstfst $1, List(sndfst $1)), snd $1} /* (1, 2) */
-| parenthesized arrayref {sp_0($2); (P_tok, Deref_with(I_array, List(sndfst $1), List(fst $2))), sp_pos_range $1 $2} /* list slice */
+| parenthesized arrayref {sp_0($2); (P_tok, to_Deref_with(I_array, (if is_only_one_in_List(fst $2) then I_scalar else I_array), List(sndfst $1), List(fst $2))), sp_pos_range $1 $2} /* list indexing or slicing */
 
 | variable {(P_tok, fst $1), snd $1}
 
 | subscripted {(P_tok, fst $1), snd $1}
 
-| array arrayref {(P_expr, Deref_with(I_array, from_array $1, List(fst $2))), sp_pos_range $1 $2} /* array slice: @array[vals] */
-| array BRACKET expr BRACKET_END {sp_0($2); sp_0($3); sp_0($4); (P_expr, Deref_with(I_hash, from_array $1, sndfst $3)), sp_pos_range $1 $4} /* hash slice: @hash{@keys} */
+| array arrayref {(P_expr, to_Deref_with(I_array, I_array, from_array $1, List(fst $2))), sp_pos_range $1 $2} /* array slice: @array[vals] */
+| array BRACKET expr BRACKET_END {sp_0($2); sp_0($3); sp_0($4); (P_expr, to_Deref_with(I_hash, I_array, from_array $1, sndfst $3)), sp_pos_range $1 $4} /* hash slice: @hash{@keys} */
 
 
 /* function_calls */
 | func parenthesized {sp_0($2); (P_tok, call_func true (fst $1, sndfst $2)), sp_pos_range $1 $2} /* &foo(@args) */
 | word argexpr {check_parenthesized_first_argexpr (string_of_Ident (fst $1)) $2; (P_call_no_paren, call(Deref(I_func, fst $1), sndfst $2)), sp_pos_range $1 $2} /* foo $a, $b */
-| word_paren parenthesized {(P_tok, call(Deref(I_func, fst $1), sndfst $2)), sp_pos_range $1 $2} /* foo(@args) */
+| word_paren parenthesized {sp_0($2); (P_tok, call(Deref(I_func, fst $1), sndfst $2)), sp_pos_range $1 $2} /* foo(@args) */
 | word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; ((if sndfst $5 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub(fst $3) :: sndfst $5)), sp_pos_range $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); ((if sndfst $7 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub [ Ref(I_hash, sndfst $4) ] :: sndfst $7)), sp_pos_range $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); ((if sndfst $8 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub [ Ref(I_hash, sndfst $4); Semi_colon ] :: sndfst $8)), sp_pos_range $1 $8} /* map { { foo }; } @bar */
 
-| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); (P_tok, to_Method_callP(sndfst $1, fst $3, sndfst $4)), sp_pos_range $1 $4} /* $foo->bar(list) */
-| term ARROW word_or_scalar {sp_0($2); sp_0($3); (P_tok, to_Method_callP(sndfst $1, fst $3, [])), sp_pos_range $1 $3} /* $foo->bar */
-| term ARROW MULT parenthesized {check_MULT_is_x $3; sp_0($2); sp_0($3); sp_0($4); (P_tok, to_Method_callP(sndfst $1, Ident(None, "x", get_pos $3), sndfst $4)), sp_pos_range $1 $4} /* $foo->bar(list) */
-| term ARROW MULT {check_MULT_is_x $3; sp_0($2); sp_0($3); (P_tok, to_Method_callP(sndfst $1, Ident(None, "x", get_pos $3), [])), sp_pos_range $1 $3} /* $foo->bar */
+| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); (P_tok, to_Method_call(sndfst $1, fst $3, sndfst $4)), sp_pos_range $1 $4} /* $foo->bar(list) */
+| term ARROW word_or_scalar {sp_0($2); sp_0($3); (P_tok, to_Method_call(sndfst $1, fst $3, [])), sp_pos_range $1 $3} /* $foo->bar */
+| term ARROW MULT parenthesized {check_MULT_is_x $3; sp_0($2); sp_0($3); sp_0($4); (P_tok, to_Method_call(sndfst $1, Ident(None, "x", get_pos $3), sndfst $4)), sp_pos_range $1 $4} /* $foo->bar(list) */
+| term ARROW MULT {check_MULT_is_x $3; sp_0($2); sp_0($3); (P_tok, to_Method_call(sndfst $1, Ident(None, "x", get_pos $3), [])), sp_pos_range $1 $3} /* $foo->bar */
 
 | NEW word { sp_n($2); (P_call_no_paren, to_Method_call(fst $2, Ident(None, "new", get_pos $1), [])), sp_pos_range $1 $2} /* new Class */
 | NEW word_paren parenthesized { sp_n($2); sp_0($3); (P_call_no_paren, to_Method_call(fst $2, Ident(None, "new", get_pos $1), sndfst $3)), sp_pos_range $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 { (P_call_no_paren, Call_op(fst $1, var_STDOUT :: [ var_dollar_ ])), snd $1}
-| PRINT argexpr {check_parenthesized_first_argexpr (fst $1) $2; (P_call_no_paren, Call_op(fst $1, var_STDOUT :: sndfst $2)), sp_pos_range $1 $2}
-| PRINT_TO_SCALAR         { (P_call_no_paren, Call_op(fstfst $1, var_STDOUT :: [ Deref(I_scalar, Ident(None, sndfst $1, get_pos $1)) ])), snd $1}
-| PRINT_TO_SCALAR argexpr { (P_call_no_paren, Call_op(fstfst $1, Deref(I_scalar, Ident(None, sndfst $1, get_pos $1)) :: sndfst $2)), sp_pos_range $1 $2}
-| PRINT_TO_STAR           { (P_call_no_paren, Call_op(fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: [ var_dollar_ ])), snd $1}
-| PRINT_TO_STAR argexpr   { (P_call_no_paren, Call_op(fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: sndfst $2)), sp_pos_range $1 $2}
+| PRINT { to_Call_op_(P_call_no_paren, fst $1, var_STDOUT :: [ var_dollar_ ]) (snd $1)}
+| PRINT argexpr {check_parenthesized_first_argexpr (fst $1) $2; to_Call_op_(P_call_no_paren, fst $1, var_STDOUT :: sndfst $2) (sp_pos_range $1 $2)}
+| PRINT_TO_SCALAR         { to_Call_op_(P_call_no_paren, fstfst $1, var_STDOUT :: [ Deref(I_scalar, Ident(None, sndfst $1, get_pos $1)) ]) (snd $1)}
+| PRINT_TO_SCALAR argexpr { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_scalar, Ident(None, sndfst $1, get_pos $1)) :: sndfst $2) (sp_pos_range $1 $2)}
+| PRINT_TO_STAR           { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: [ var_dollar_ ]) (snd $1)}
+| PRINT_TO_STAR argexpr   { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: sndfst $2) (sp_pos_range $1 $2)}
 
 | hash PKG_SCOPE {sp_0($2); (P_tok, Too_complex), sp_pos_range $1 $2} /* %main:: */
 
@@ -315,38 +316,39 @@ term:
 terminal:
 | word {(P_tok, check_word_alone $1), snd $1}
 | NUM {(P_tok, Num(fst $1, get_pos $1)), snd $1}
-| STRING {(P_tok, to_String $1), snd $1}
+| STRING {(P_tok, to_String true $1), snd $1}
 | RAW_STRING {(P_tok, to_Raw_string $1), snd $1}
 | REVISION {(P_tok, to_Raw_string $1), snd $1}
-| COMMAND_STRING {(P_expr, Call_op("``", [to_String $1])), snd $1}
-| QUOTEWORDS {(P_tok, Call_op("qw", [to_Raw_string $1])), snd $1}
+| COMMAND_STRING {to_Call_op_(P_expr, "``", [to_String false $1]) (snd $1)}
+| QUOTEWORDS {to_Call_op_(P_tok, "qw", [to_Raw_string $1]) (snd $1)}
 | HERE_DOC {(P_tok, String([], raw_pos2pos (sndfst $1))), snd $1}
 | RAW_HERE_DOC {(P_tok, Raw_string(fstfst $1, raw_pos2pos (sndfst $1))), snd $1}
-| PATTERN {(P_expr, Call_op("m//", var_dollar_ :: from_PATTERN $1)), snd $1}
-| PATTERN_SUBST {(P_expr, Call_op("s///", var_dollar_ :: from_PATTERN_SUBST $1)), snd $1}
+| PATTERN {to_Call_op_(P_expr, "m//", var_dollar_ :: from_PATTERN $1) (snd $1)}
+| PATTERN_SUBST {to_Call_op_(P_expr, "s///", var_dollar_ :: from_PATTERN_SUBST $1) (snd $1)}
 | diamond {(P_expr, fst $1), snd $1}
 
 diamond:
-| LT GT {sp_0($2); Call_op("<>", []), sp_pos_range $1 $2}
-| LT term GT {sp_0($2); sp_0($3); Call_op("<>", [sndfst $2]), sp_pos_range $1 $3}
+| LT GT {sp_0($2); to_Call_op("<>", []) (sp_pos_range $1 $2)}
+| LT term GT {sp_0($2); sp_0($3); to_Call_op("<>", [sndfst $2]) (sp_pos_range $1 $3)}
 
 subscripted: /* Some kind of subscripted expression */
 | variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); Too_complex, sp_pos_range $1 $3} /* $foo::{something} */
-| scalar bracket_subscript             {sp_0($2); Deref_with(I_hash , from_scalar $1, fst      $2), sp_pos_range $1 $2} /* $foo{bar} */
-| scalar arrayref                      {sp_0($2); Deref_with(I_array, from_scalar $1, only_one $2), sp_pos_range $1 $2} /* $array[$element] */
-| term ARROW bracket_subscript         {sp_0($2); sp_0($3); Deref_with(I_hash , sndfst $1, fst      $3), sp_pos_range $1 $3} /* somehref->{bar} */
-| term ARROW arrayref                  {sp_0($2); sp_0($3); Deref_with(I_array, sndfst $1, only_one $3), sp_pos_range $1 $3} /* somearef->[$element] */
-| term ARROW parenthesized             {sp_0($2); sp_0($3); Deref_with(I_func , sndfst $1, List(sndfst $3)), sp_pos_range $1 $3} /* $subref->(@args) */
-| subscripted bracket_subscript        {sp_0($2); Deref_with(I_hash , fst $1, fst      $2), sp_pos_range $1 $2} /* $foo->[bar]{baz} */
-| subscripted arrayref                 {sp_0($2); Deref_with(I_array, fst $1, only_one $2), sp_pos_range $1 $2} /* $foo->[$bar][$baz] */
-| subscripted parenthesized            {sp_0($2); Deref_with(I_func , fst $1, List(sndfst $2)), sp_pos_range $1 $2} /* $foo->{bar}(@args) */
+| scalar bracket_subscript             {sp_0($2); to_Deref_with(I_hash , I_scalar, from_scalar $1, fst      $2), sp_pos_range $1 $2} /* $foo{bar} */
+| scalar arrayref                      {sp_0($2); to_Deref_with(I_array, I_scalar, from_scalar $1, only_one $2), sp_pos_range $1 $2} /* $array[$element] */
+| term ARROW bracket_subscript         {sp_0($2); sp_0($3); check_arrow_needed $1 $2; to_Deref_with(I_hash , I_scalar, sndfst $1, fst      $3), sp_pos_range $1 $3} /* somehref->{bar} */
+| term ARROW arrayref                  {sp_0($2); sp_0($3); check_arrow_needed $1 $2; to_Deref_with(I_array, I_scalar, sndfst $1, only_one $3), sp_pos_range $1 $3} /* somearef->[$element] */
+| term ARROW parenthesized             {sp_0($2); sp_0($3); to_Deref_with(I_func , I_scalar, sndfst $1, List(sndfst $3)), sp_pos_range $1 $3} /* $subref->(@args) */
+| subscripted bracket_subscript        {sp_0($2); to_Deref_with(I_hash , I_scalar, fst $1, fst      $2), sp_pos_range $1 $2} /* $foo->[bar]{baz} */
+| subscripted arrayref                 {sp_0($2); to_Deref_with(I_array, I_scalar, fst $1, only_one $2), sp_pos_range $1 $2} /* $foo->[$bar][$baz] */
+| subscripted parenthesized            {sp_0($2); to_Deref_with(I_func , I_scalar, fst $1, List(sndfst $2)), sp_pos_range $1 $2} /* $foo->{bar}(@args) */
 
 restricted_subscripted: /* Some kind of subscripted expression */
-| scalar bracket_subscript             {sp_0($2); Deref_with(I_hash , from_scalar $1, fst      $2), sp_pos_range $1 $2} /* $foo{bar} */
-| scalar arrayref                      {sp_0($2); Deref_with(I_array, from_scalar $1, only_one $2), sp_pos_range $1 $2} /* $array[$element] */
-| restricted_subscripted bracket_subscript        {sp_0($2); Deref_with(I_hash , fst $1, fst      $2), sp_pos_range $1 $2} /* $foo->[bar]{baz} */
-| restricted_subscripted arrayref                 {sp_0($2); Deref_with(I_array, fst $1, only_one $2), sp_pos_range $1 $2} /* $foo->[$bar][$baz] */
-| restricted_subscripted parenthesized            {sp_0($2); Deref_with(I_func , fst $1, List(sndfst $2)), sp_pos_range $1 $2} /* $foo->{bar}(@args) */
+| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); Too_complex, sp_pos_range $1 $3} /* $foo::{something} */
+| scalar bracket_subscript             {sp_0($2); to_Deref_with(I_hash , I_scalar, from_scalar $1, fst      $2), sp_pos_range $1 $2} /* $foo{bar} */
+| scalar arrayref                      {sp_0($2); to_Deref_with(I_array, I_scalar, from_scalar $1, only_one $2), sp_pos_range $1 $2} /* $array[$element] */
+| restricted_subscripted bracket_subscript        {sp_0($2); to_Deref_with(I_hash , I_scalar, fst $1, fst      $2), sp_pos_range $1 $2} /* $foo->[bar]{baz} */
+| restricted_subscripted arrayref                 {sp_0($2); to_Deref_with(I_array, I_scalar, fst $1, only_one $2), sp_pos_range $1 $2} /* $foo->[$bar][$baz] */
+| restricted_subscripted parenthesized            {sp_0($2); to_Deref_with(I_func , I_scalar, fst $1, List(sndfst $2)), sp_pos_range $1 $2} /* $foo->{bar}(@args) */
 
 arrayref:
 | arrayref_start ARRAYREF_END {sp_0($2); fst $1, sp_pos_range $1 $2}
@@ -386,7 +388,7 @@ termdo: /* Things called with "do" */
 | DO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; Block(fst $3), sp_pos_range $1 $4} /* do { code */
 
 bracket_subscript:
-| BRACKET expr BRACKET_END {sp_0($1); sp_same $2 $3; only_one_in_List $2, sp_pos_range $1 $3}
+| BRACKET expr BRACKET_END {sp_0($1); sp_same $2 $3; check_hash_subscript $2; only_one_in_List $2, sp_pos_range $1 $3}
 | COMPACT_HASH_SUBSCRIPT {sp_0($1); to_Raw_string $1, snd $1}
 
 variable:
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index 0fe96b7..62a85f0 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -11,7 +11,12 @@ let get_pos (_, (_, pos)) = raw_pos2pos pos
 let var_dollar_ = Deref(I_scalar, Ident(None, "_", raw_pos2pos bpos))
 let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos))
 
+let is_var_dollar_ = function
+  | Deref(I_scalar, Ident(None, "_", _)) -> true
+  | _ -> false
+
 let is_parenthesized = function
+  | List[]
   | List[List[_]] -> true
   | _ -> false
 
@@ -26,8 +31,8 @@ let rec un_parenthesize_full = function
 let not_complex e =
   if is_parenthesized e then true else
   let rec not_complex_ op = function
-    | Call_op("?:", _) -> false
-    | Call_op(op', l) -> op <> op' && List.for_all (not_complex_ op') l
+    | Call_op("?:", _, _) -> false
+    | Call_op(op', l, _) -> op <> op' && List.for_all (not_complex_ op') l
     | e -> not (is_parenthesized e)
   in not_complex_ "" (un_parenthesize_full e)
 
@@ -39,6 +44,44 @@ let string_of_Ident = function
   | Ident(None, s, _) -> s
   | Ident(Some fq, s, _) -> fq ^ "::" ^ s
   | _ -> internal_error "string_of_Ident"
+let context2s = function
+  | I_scalar -> "$"
+  | I_hash -> "%"
+  | I_array -> "@"
+  | I_func -> "&"
+  | I_raw -> ""
+  | I_star -> "*"
+let variable2s(context, ident) = context2s context ^ ident
+
+let non_scalar_context context = context = I_hash || context = I_array
+
+let rec is_same_fromparser a b =
+  match a, b with
+  | Undef, Undef -> true
+  | Ident(fq1, s1, _), Ident(fq2, s2, _) -> fq1 = fq2 && s1 = s2
+  | Num(s1, _), Num(s2, _) 
+  | Raw_string(s1, _), Raw_string(s2, _) -> s1 = s2
+
+  | String(l1, _), String(l2, _) ->
+      List.for_all2 (fun (s1, e1) (s2, e2) -> s1 = s2 && is_same_fromparser e1 e2) l1 l2
+
+  | Ref(c1, e1), Ref(c2, e2)
+  | Deref(c1, e1), Deref(c2, e2) -> c1 = c2 && is_same_fromparser e1 e2
+
+  | Deref_with(c1, c_1, e1, e_1), Deref_with(c2, c_2, e2, e_2) -> c1 = c2 && c_1 = c_2 && is_same_fromparser e1 e2 && is_same_fromparser e_1 e_2
+
+  | Diamond(None), Diamond(None) -> true
+  | Diamond(Some e1), Diamond(Some e2) -> is_same_fromparser e1 e2
+
+  | List(l1), List(l2) -> List.for_all2 is_same_fromparser l1 l2
+
+  | Call_op(op1, l1, _), Call_op(op2, l2, _) -> op1 = op2 && List.for_all2 is_same_fromparser l1 l2
+  | Call(e1, l1), Call(e2, l2) -> is_same_fromparser e1 e2 && List.for_all2 is_same_fromparser l1 l2
+
+  | Method_call(e1, m1, l1), Method_call(e2, m2, l2) ->
+      is_same_fromparser e1 e2 && is_same_fromparser m1 m2 && List.for_all2 is_same_fromparser l1 l2
+
+  | _ -> false
 
 let from_scalar (e, _) =
   match e with
@@ -204,21 +247,51 @@ let check_parenthesized_first_argexpr word ((_, e), (_, (start, _)) as ex) =
   let want_space = word.[0] = '-' in
   if word = "return" then () else
   match e with
-  | [ Call_op(_, (e' :: l)) ]
+  | [ Call_op(_, (e' :: l), _) ]
   | e' :: l ->
       if is_parenthesized e' then
-	if want_space then
-	  if l = [] then sp_n(ex) else die_with_rawpos (start, start) "can't handle this nicely"
-	else
-	  if l = [] then sp_0(ex) else die_with_rawpos (start, start) "you must not have a space here"
+	if l = [] then 
+	  (if want_space then sp_n else sp_0) ex
+	else die_with_rawpos (start, start) "can't handle this nicely"
+      else
+	sp_p(ex)
   | _ -> 
       if word = "time" then die_rule "please use time() instead of time";
       sp_p(ex)
 
-let check_foreach (s, (_, pos)) = if s = "for"     then warn pos "write \"foreach\" instead of \"for\""
-let check_for     (s, (_, pos)) = if s = "foreach" then warn pos "write \"for\" instead of \"foreach\""
+let check_hash_subscript ((_, e), (_, pos)) =
+  let can_be_raw_string = function
+    | "" | "x" | "y" -> false (* special case for {'y'} otherwise the emacs mode goes wild, special case for {'x'} to have the same as {'y'} (since they usually go together) *)
+    | s -> 
+	char_is_alpha s.[0] && (String.length s = 1 || string_forall_with char_is_alphanumerical_ 1 s)
+  in
+  match e with
+  | List [String ([(s, List [])], _)] when can_be_raw_string s -> warn pos (sprintf "{\"%s\"} can be written {%s}" s s)
+  | List [Raw_string(s, _)] when can_be_raw_string s -> warn pos (sprintf "{'%s'} can be written {%s}" s s)
+  | _ -> ()
+
+let check_arrow_needed ((_, e), _) ter =
+  match e with
+  | Deref_with(I_array, I_scalar, List [List [Call _]], _) -> () (* "->" needed for (f())[0]->{XX} *)
+  | Deref_with _ -> warn (sndsnd ter) "the arrow \"->\" is unneeded"
+  | _ -> ()
+
+let check_unneeded_var_dollar_    ((_, e), (_, pos)) = if is_var_dollar_ e then warn pos "\"$_ =~ /regexp/\" can be written \"/regexp/\""
+let check_unneeded_var_dollar_s   ((_, e), (_, pos)) = if is_var_dollar_ e then warn pos "\"$_ =~ s/regexp/.../\" can be written \"s/regexp/.../\""
+let check_unneeded_var_dollar_not ((_, e), (_, pos)) = if is_var_dollar_ e then warn pos "\"$_ !~ /regexp/\" can be written \"!/regexp/\""
+
 let check_MULT_is_x (s, _) = if s <> "x" then die_rule "syntax error"
 let check_my (s, _) = if s <> "my" then die_rule "syntax error"
+let check_foreach (s, (_, pos)) = if s = "for"     then warn pos "write \"foreach\" instead of \"for\""
+let check_for     (s, (_, pos)) = if s = "foreach" then warn pos "write \"for\" instead of \"foreach\""
+let check_for_foreach (s, (_, pos)) ((_, expr), _) =
+  match expr with
+  | List [ Deref(I_scalar, _) ] ->
+      if s = "foreach" then warn pos "you are using the special fpons trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\""
+  | List [ Deref_with(context, I_scalar, _, _) ] when context <> I_func -> 
+      if s = "foreach" then warn pos "you are using the special fpons trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\""
+  | _ -> 
+      if s = "for" then warn pos "write \"foreach\" instead of \"for\""
 
 let check_block_sub (l, (_, (_, end_)) as ter_lines) (_, (space, _) as ter_BRACKET_END) =  
   if l = [] then
@@ -254,6 +327,15 @@ let only_one_in_List ((_, e), both) =
   | List l -> only_one(l, both)
   | _ -> e
   
+let rec is_only_one_in_List = function
+  | [List l] -> is_only_one_in_List l
+  | [_] -> true
+  | _ -> false
+  
+let is_not_a_scalar = function
+  | Deref_with(_, context, _, _)
+  | Deref(context, _) -> non_scalar_context context
+  | _ -> false
 
 let maybe_to_Raw_string = function
   | Ident(None, s, pos) -> Raw_string(s, pos)
@@ -267,8 +349,12 @@ let to_List = function
 let deref_arraylen e = Call(Deref(I_func, Ident(None, "int", raw_pos2pos bpos)), [Deref(I_array, e)])
 let to_Ident ((fq, name), (_, pos)) = Ident(fq, name, raw_pos2pos pos)
 let to_Raw_string (s, (_, pos)) = Raw_string(s, raw_pos2pos pos)
-let to_Method_callP(object_, method_, para) = Method_callP(maybe_to_Raw_string object_, maybe_to_Raw_string method_, para)
-let to_Method_call (object_, method_, para) = Method_call (maybe_to_Raw_string object_, maybe_to_Raw_string method_, para)
+let to_Method_call (object_, method_, para) = Method_call(maybe_to_Raw_string object_, maybe_to_Raw_string method_, para)
+let to_Deref_with(from_context, to_context, ref_, para) =
+  if is_not_a_scalar ref_ then warn_rule "bad deref";
+  Deref_with(from_context, to_context, ref_, para)
+
+  
 let to_Local ((_, e), (_, pos)) =
   let l = 
     match e with
@@ -281,14 +367,14 @@ let to_Local ((_, e), (_, pos)) =
     | Deref(I_scalar, Ident _)
     | Deref(I_array, Ident _)
     | Deref(I_star, Ident _)
-    | Deref_with(I_hash, Ident _, _)
-    | Deref_with(I_hash, Deref(I_scalar, _), _)
-    | Deref_with(I_hash, Deref_with(I_hash, Ident _, _), _)
-    | Deref_with(I_hash, Deref_with(I_hash, Deref(I_scalar, Ident _), _), _) ->
+    | Deref_with(I_hash, I_scalar, Ident _, _)
+    | Deref_with(I_hash, I_scalar, Deref(I_scalar, _), _)
+    | Deref_with(I_hash, I_scalar, Deref_with(I_hash, I_scalar, Ident _, _), _)
+    | Deref_with(I_hash, I_scalar, Deref_with(I_hash, I_scalar, Deref(I_scalar, Ident _), _), _) ->
 	None
     | _ -> die_with_rawpos pos "bad argument to \"local\""
   ) l in
-  if local_vars = [] then Call_op("local", local_exprs)
+  if local_vars = [] then Call_op("local", local_exprs, raw_pos2pos pos)
   else if local_exprs = [] then My_our("local", local_vars, raw_pos2pos pos)
   else die_with_rawpos pos "bad argument to \"local\""
 
@@ -298,41 +384,43 @@ let op_p prio s e = sp_p e ; op prio s e
 let sub_declaration (name, proto) body = Sub_declaration(name, proto, Block body)
 let anonymous_sub body = Anonymous_sub (Block body)
 
-let call_op((prio, (prev_ter, op)), (_, (_, pos) as ter), para) = 
+let cook_call_op(op, para, pos) =
+  let call = Call_op(op, para, raw_pos2pos pos) in
+  match op, para with
+  | "=", [My_our _; Ident(None, "undef", _)] -> 
+      warn pos "no need to initialize variable, it's done by default" ;
+      call
+  | "=", [My_our _; List[]] -> 
+      if Info.is_on_same_line_current pos then warn pos "no need to initialize variables, it's done by default" ;
+      call
+
+  | "=", [ Deref(I_star, String ([(sf1, List [])], _)); _ ] ->
+      warn_rule (sprintf "write *{'%s'} instead of *{\"%s\"}" sf1 sf1) ;
+      call
+
+  | "=", [ Deref(I_star, (Ident _ as f1)); Deref(I_star, (Ident _ as f2)) ] ->
+      let s1, s2 = string_of_Ident f1, string_of_Ident f2 in
+      warn pos (sprintf "\"*%s = *%s\" is better written \"*%s = \\&%s\"" s1 s2 s1 s2) ;
+      sub_declaration (f1, "") [ Deref(I_func, f2) ]
+  | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Deref(I_star, (Ident _ as f2)) ] ->
+      let s2 = string_of_Ident f2 in
+      warn pos (sprintf "\"*{'%s'} = *%s\" is better written \"*{'%s'} = \\&%s\"" sf1 s2 sf1 s2) ;
+      sub_declaration (Ident(None, sf1, pos_f1), "") [ Deref(I_func, f2) ]
+
+  | "=", [ Deref(I_star, (Ident _ as f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
+      sub_declaration (f1, "") [ Deref(I_func, f2) ]
+  | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
+      sub_declaration (Ident(None, sf1, pos_f1), "") [ Deref(I_func, f2) ]
+
+  | _ -> 
+      call
+
+let call_op_((prio, (prev_ter, op)), ter, para) (sp, pos) = 
   sp_same prev_ter ter ;
+  (prio, cook_call_op(op, para, pos)), (sp, pos)
 
-  let call = Call_op(op, para) in
-  let call =
-    match op, para with
-    | "=", [List [My_our _]; Ident(None, "undef", _)] -> 
-	warn pos "no need to initialize variable, it's done by default" ;
-	call
-    | "=", [List [My_our _]; List[]] -> 
-	if Info.is_on_same_line_current pos then warn pos "no need to initialize variables, it's done by default" ;
-	call
-
-    | "=", [ Deref(I_star, String ([(sf1, List [])], _)); _ ] ->
-	warn_rule (sprintf "write *{'%s'} instead of *{\"%s\"}" sf1 sf1) ;
-	call
-
-    | "=", [ Deref(I_star, (Ident _ as f1)); Deref(I_star, (Ident _ as f2)) ] ->
-	let s1, s2 = string_of_Ident f1, string_of_Ident f2 in
-	warn pos (sprintf "\"*%s = *%s\" is better written \"*%s = \\&%s\"" s1 s2 s1 s2) ;
-	sub_declaration (f1, "") [ Deref(I_func, f2) ]
-    | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Deref(I_star, (Ident _ as f2)) ] ->
-	let s2 = string_of_Ident f2 in
-	warn pos (sprintf "\"*{'%s'} = *%s\" is better written \"*{'%s'} = \\&%s\"" sf1 s2 sf1 s2) ;
-	sub_declaration (Ident(None, sf1, pos_f1), "") [ Deref(I_func, f2) ]
-
-    | "=", [ Deref(I_star, (Ident _ as f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
-	sub_declaration (f1, "") [ Deref(I_func, f2) ]
-    | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
-	sub_declaration (Ident(None, sf1, pos_f1), "") [ Deref(I_func, f2) ]
-
-    | _ -> 
-	call
-  in
-  prio, call
+let to_Call_op(op, para) (sp, pos) = Call_op(op, para, raw_pos2pos pos), (sp, pos)
+let to_Call_op_(prio, op, para) (sp, pos) = (prio, Call_op(op, para, raw_pos2pos pos)), (sp, pos)
 
 let followed_by_comma ((_,e), _) (true_comma, _) =
   if true_comma then e else
@@ -344,12 +432,6 @@ let call_func is_a_func (e, para) =
   match e with
   | Deref(I_func, Ident(None, f, _)) ->
       let para' = match f with
-      | "require" ->
-	  (match para with
-	  | [ Ident(_, _, pos) as s ] -> Some [ Raw_string(string_of_Ident s, pos) ]
-	  | [ String _ ]
-	  | [ Raw_string _ ] -> None
-	  | _ -> die_rule "use either \"require PACKAGE\" or \"require 'PACKAGE.pm'\"")
       | "no" ->
 	  (match para with
 	  | [ Ident(_, _, pos) as s ] -> Some [ Raw_string(string_of_Ident s, pos) ]
@@ -357,7 +439,8 @@ let call_func is_a_func (e, para) =
 	  | _ -> die_rule "use \"no PACKAGE <para>\"")
       | "N" | "N_" ->
 	  (match para with
-	  | [List(String _ :: _)] -> None
+	  | [ List(String([ _s, List [] ], _) :: _) ] -> None
+	  | [ List(String _ :: _) ] -> die_rule "don't use interpolated translated string, use %s or %d instead"
 	  |  _ -> die_rule (sprintf "%s() must be used with a string" f))
 
       | "goto" ->
@@ -370,6 +453,11 @@ let call_func is_a_func (e, para) =
 	  | [ Ident(None, s, pos) ] -> Some [ Raw_string(s, pos) ]
 	  | _ -> die_rule (sprintf "%s must be used with a raw string" f))
 
+      | "length" ->
+	  if para = [] then warn_rule "length() with no parameter !?" else
+	  if is_not_a_scalar (List.hd para) then warn_rule "never use \"length @l\", it returns the length of the string int(@l)" ;
+	  None
+	    
       | _ -> None
       in Call(e, some_or para' para)
   | _ -> Call(e, para)
@@ -383,10 +471,34 @@ let call_one_scalar_para (e, (_, pos)) para =
     | "defined" -> P_expr
     | _ -> P_add
   in
-  pri, Call(Deref(I_func, Ident(None, e, raw_pos2pos pos)), para)
+  pri, call(Deref(I_func, Ident(None, e, raw_pos2pos pos)), para)
+
+
+let call_op_if_infix left right (sp, pos) =
+  (match left, right with
+  | List [Call_op("=", [Deref(context, _); _], _)], _ when non_scalar_context context -> ()
+  | List [Call_op("=", [v; _], _)],
+    List [Call_op("not", [v'], _)] when is_same_fromparser v v' ->
+      warn_rule "\"$foo = ... if !$foo\" can be written \"$foo ||= ...\""
+  | _ -> ());
+  Call_op("if infix", [ left ; right], raw_pos2pos pos), (sp, pos)
+
+let call_op_unless_infix left right (sp, pos) =
+  (match left, right with
+  | List [Call_op("=", [Deref(context, _); _], _)], _ when non_scalar_context context -> ()
+  | List [Call_op("=", [v; _], _)], List [v'] when is_same_fromparser v v' ->
+      warn_rule "\"$foo = ... unless $foo\" can be written \"$foo ||= ...\""
+  | _ -> ());
+  (match right with
+  | List [Call_op(op, _, _)] ->
+      (match op with
+      | "&&" | "||" | "not" | "ne" | "?:" -> warn_rule "don't use \"unless\" when the condition is complex, use \"if\" instead"
+      | _ -> ());
+  | _ -> ());
+  Call_op("unless infix", [ left ; right], raw_pos2pos pos), (sp, pos)
 
-let (current_lexbuf : Lexing.lexbuf option ref) = ref None
 
+let (current_lexbuf : Lexing.lexbuf option ref) = ref None
 
 let rec list2tokens l =
   let rl = ref l in
@@ -404,9 +516,25 @@ let parse_tokens parse tokens lexbuf_opt =
   if tokens = [] then [] else
   parse (list2tokens tokens) (some !current_lexbuf)
 
-let parse_interpolated parse l = List.map (fun (s, tokens) -> s, to_List(parse_tokens parse tokens None)) l
-
-let to_String parse (l, (_, pos)) = String(parse_interpolated parse l, raw_pos2pos pos)
+let parse_interpolated parse l = 
+  let l' = List.map (fun (s, tokens) -> s, to_List(parse_tokens parse tokens None)) l in
+  match split_last l' with
+  | pl, ("", List []) -> pl
+  | _ -> l'
+
+let to_String parse strict (l, (_, pos)) = 
+  let l' = parse_interpolated parse l in
+  (match l' with
+  | [ "", List [Deref(I_scalar, Ident(None, ident, _))]] -> 
+      if strict then warn pos (sprintf "%s is better written without the double quotes" (variable2s(I_scalar, ident)))
+  | [ "", List [Deref(I_hash, _)]] -> 
+      warn pos "don't use a hash in string context"
+  | [ "", List [Deref(I_array, _)]] -> 
+      ()
+  | [("", _)] -> 
+      if strict then warn pos "double quotes are unneeded"
+  | _ -> ());
+  String(l', raw_pos2pos pos)
 
 let from_PATTERN parse ((s, opts), (_, pos)) = 
   [ String(parse_interpolated parse s, raw_pos2pos pos) ; 
diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli
index 879d194..e617547 100644
--- a/perl_checker.src/parser_helper.mli
+++ b/perl_checker.src/parser_helper.mli
@@ -7,12 +7,17 @@ val sp_pos_range :
 val get_pos : 'a * ('b * ('c * 'd)) -> string * 'c * 'd
 val var_dollar_ : Types.fromparser
 val var_STDOUT : Types.fromparser
+val is_var_dollar_ : Types.fromparser -> bool
 val is_parenthesized : Types.fromparser -> bool
 val un_parenthesize : Types.fromparser -> Types.fromparser
 val un_parenthesize_full : Types.fromparser -> Types.fromparser
 val not_complex : Types.fromparser -> bool
 val not_simple : Types.fromparser -> bool
 val string_of_Ident : Types.fromparser -> string
+val context2s : Types.context -> string
+val variable2s : Types.context * string -> string
+val non_scalar_context : Types.context -> bool
+val is_same_fromparser : Types.fromparser -> Types.fromparser -> bool
 val from_scalar : Types.fromparser * 'a -> Types.fromparser
 val from_array : Types.fromparser * 'a -> Types.fromparser
 val msg_with_rawpos : int * int -> string -> string
@@ -51,10 +56,22 @@ val check_word_alone : Types.fromparser * 'a -> Types.fromparser
 val check_parenthesized_first_argexpr :
   string ->
   ('a * Types.fromparser list) * (Types.spaces * (int * 'b)) -> unit
-val check_foreach : string * ('a * (int * int)) -> unit
-val check_for : string * ('a * (int * int)) -> unit
+val check_hash_subscript :
+  ('a * Types.fromparser) * ('b * (int * int)) -> unit
+val check_arrow_needed :
+  ('a * Types.fromparser) * 'b -> 'c * ('d * (int * int)) -> unit
+val check_unneeded_var_dollar_ :
+  ('a * Types.fromparser) * ('b * (int * int)) -> unit
+val check_unneeded_var_dollar_s :
+  ('a * Types.fromparser) * ('b * (int * int)) -> unit
+val check_unneeded_var_dollar_not :
+  ('a * Types.fromparser) * ('b * (int * int)) -> unit
 val check_MULT_is_x : string * 'a -> unit
 val check_my : string * 'a -> unit
+val check_foreach : string * ('a * (int * int)) -> unit
+val check_for : string * ('a * (int * int)) -> unit
+val check_for_foreach :
+  string * ('a * (int * int)) -> ('b * Types.fromparser) * 'c -> unit
 val check_block_sub :
   Types.fromparser list * (Types.spaces * (int * int)) ->
   'a * (Types.spaces * (int * 'b)) -> unit
@@ -65,18 +82,20 @@ val check_my_our_paren : ((bool * 'a) * 'b) * 'c -> unit
 val only_one : Types.fromparser list * ('a * (int * int)) -> Types.fromparser
 val only_one_in_List :
   ('a * Types.fromparser) * ('b * (int * int)) -> Types.fromparser
+val is_only_one_in_List : Types.fromparser list -> bool
+val is_not_a_scalar : Types.fromparser -> bool
 val maybe_to_Raw_string : Types.fromparser -> Types.fromparser
 val to_List : Types.fromparser list -> Types.fromparser
 val deref_arraylen : Types.fromparser -> Types.fromparser
 val to_Ident :
   (string option * string) * ('a * (int * int)) -> Types.fromparser
 val to_Raw_string : string * ('a * (int * int)) -> Types.fromparser
-val to_Method_callP :
-  Types.fromparser * Types.fromparser * Types.fromparser list ->
-  Types.fromparser
 val to_Method_call :
   Types.fromparser * Types.fromparser * Types.fromparser list ->
   Types.fromparser
+val to_Deref_with :
+  Types.context * Types.context * Types.fromparser * Types.fromparser ->
+  Types.fromparser
 val to_Local :
   ('a * Types.fromparser) * ('b * (int * int)) -> Types.fromparser
 val op : 'a -> 'b -> 'c * 'd -> 'a * ((unit * 'd) * 'b)
@@ -85,13 +104,21 @@ val op_p :
   'b ->
   'c * (Types.spaces * (int * 'd)) ->
   'a * ((unit * (Types.spaces * (int * 'd))) * 'b)
-val call_op :
-  ('a * (('b * (Types.spaces * (int * 'c))) * string)) *
-  ('d * (Types.spaces * (int * int))) * Types.fromparser list ->
-  'a * Types.fromparser
 val sub_declaration :
   Types.fromparser * string -> Types.fromparser list -> Types.fromparser
 val anonymous_sub : Types.fromparser list -> Types.fromparser
+val cook_call_op :
+  string * Types.fromparser list * (int * int) -> Types.fromparser
+val call_op_ :
+  ('a * (('b * (Types.spaces * (int * 'c))) * string)) *
+  ('d * (Types.spaces * (int * 'e))) * Types.fromparser list ->
+  'f * (int * int) -> ('a * Types.fromparser) * ('f * (int * int))
+val to_Call_op :
+  string * Types.fromparser list ->
+  'a * (int * int) -> Types.fromparser * ('a * (int * int))
+val to_Call_op_ :
+  'a * string * Types.fromparser list ->
+  'b * (int * int) -> ('a * Types.fromparser) * ('b * (int * int))
 val followed_by_comma :
   ('a * Types.fromparser list) * 'b -> bool * 'c -> Types.fromparser list
 val call_func :
@@ -100,6 +127,14 @@ 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
+val call_op_if_infix :
+  Types.fromparser ->
+  Types.fromparser ->
+  'a * (int * int) -> Types.fromparser * ('a * (int * int))
+val call_op_unless_infix :
+  Types.fromparser ->
+  Types.fromparser ->
+  'a * (int * int) -> Types.fromparser * ('a * (int * int))
 val current_lexbuf : Lexing.lexbuf option ref
 val list2tokens : ((int * int) * 'a) list -> Lexing.lexbuf -> 'a
 val parse_tokens :
@@ -107,9 +142,10 @@ val parse_tokens :
   ((int * int) * 'a) list -> Lexing.lexbuf option -> 'b list
 val parse_interpolated :
   ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) ->
-  ('b * ((int * int) * 'a) list) list -> ('b * Types.fromparser) list
+  (string * ((int * int) * 'a) list) list -> (string * Types.fromparser) list
 val to_String :
   ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) ->
+  bool ->
   (string * ((int * int) * 'a) list) list * ('b * (int * int)) ->
   Types.fromparser
 val from_PATTERN :
diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml
index 0247919..f328b32 100644
--- a/perl_checker.src/perl_checker.ml
+++ b/perl_checker.src/perl_checker.ml
@@ -27,35 +27,47 @@ let findfile dirs f = List.find Sys.file_exists (List.map (fun dir -> dir ^ "/"
 let rec parse_file state file =
   try
     if !Flags.verbose then prerr_endline ("checking " ^ file) ;
-    let lexbuf = Lexing.from_channel (Unix.open_process_in (Printf.sprintf "expand \"%s\"" file)) in
+    let channel = Unix.open_process_in (Printf.sprintf "expand \"%s\"" file) in
+    let lexbuf = Lexing.from_channel channel in
     try
       Info.start_a_new_file file ;
       let tokens = Lexer.get_token Lexer.token lexbuf in
+      (*let _ = Unix.close_process_in channel in*)
       let t = Parser_helper.parse_tokens Parser.prog tokens (Some lexbuf) in
-      let required_packages, package = get_global_info_from_package t in
-      Tree.get_vars_declaration state package ;
-      let state = { state with per_package = (package.package_name, package) :: state.per_package } in
-      let state = List.fold_left parse_package_if_needed state (required_packages @ List.map (fun (s, (_, pos)) -> s, pos) package.uses) in
-      state
+      let packages, required_packages = get_global_info_from_package t in
+      List.fold_left (fun (required_packages, state) package ->
+	Tree.get_vars_declaration state package ;
+	let state = Tree.add_package_to_state state package in
+	List.map (fun (s, (_, pos)) -> s, pos) package.uses @ required_packages, state
+      ) (required_packages, state) packages
     with Failure s -> (
       prerr_endline s ;
       exit 1
      )
-  with _ -> failwith ("bad file " ^ file)
+  with 
+  | Not_found -> internal_error "runaway Not_found"
 
 and parse_package_if_needed state (package_name, pos) =
-  if List.mem_assoc package_name state.per_package then state else
+  if List.mem_assoc package_name state.per_package then [], state else
   try
     let package = snd (List.hd state.per_package) in
     let inc = inc package.file_name package.package_name package.has_package_name in
-    if List.mem package_name !ignored_packages then state 
+    if List.mem package_name !ignored_packages then [], state
     else
-      let file = String.concat "/" (split_at2 ':'':' package_name) ^ ".pm" in
-      parse_file state (findfile inc file)
+      let rel_file = String.concat "/" (split_at2 ':'':' package_name) ^ ".pm" in
+      let file = findfile inc rel_file in
+      if List.mem file state.files_parsed 
+      then [], state (* already seen, it happens when many files have the same package_name *)
+      else parse_file state file
   with Not_found -> 
     Tree.warn_with_pos pos (Printf.sprintf "can't find package %s" package_name) ;
-    state
+    [], state
 
+let rec parse_required_packages state = function
+  | [] -> state
+  | e :: l ->
+      let el, state = parse_package_if_needed state e in
+      parse_required_packages state (el @ l)
 
 let parse_options =
   let args_r = ref [] in
@@ -67,5 +79,8 @@ let parse_options =
   Arg.parse options (lpush args_r) usage;
 
   let args = if !args_r = [] then (Unix.chdir "/home/pixel/cooker/gi/perl-install" ; ["/home/pixel/cooker/gi/perl-install/t.pl"]) else !args_r in
-  let state = List.fold_left parse_file default_state args in
+  let required_packages, state = collect_withenv parse_file default_state args in
+
+  let state = parse_required_packages state required_packages in
+
   List.iter (check_tree state) (List.map snd state.per_package)
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index 33cc111..e91e0e1 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -1,12 +1,15 @@
 open Types
 open Common
 open Printf
+open Parser_helper
+
+type special_export = Re_export_all | Export_all
 
 type exports = { 
     export_ok : (context * string) list ;
     export_auto : (context * string) list ;
     export_tags : (string * (context * string) list) list ;
-    re_export_all : bool ;
+    special_export : special_export option ;
   }
 
 type uses = (string * ((context * string) list option * pos)) list
@@ -15,12 +18,14 @@ type per_package = {
     file_name : string ;
     package_name : string ; has_package_name : bool ;
     vars_declared : (context * string, pos) Hashtbl.t ;
+    imported : ((context * string) * string) list option ref ;
     exports : exports ;
     uses : uses ;
     body : fromparser list;
   }
 type state = {
     per_package : (string * per_package) list ;
+    files_parsed : string list ;
     global_vars_declared : (context * string * string, pos) Hashtbl.t ;
     global_vars_used : ((context * string * string) * pos) list ref ;
   }
@@ -28,28 +33,20 @@ type state = {
 type vars = { 
     my_vars : (context * string) list list ;
     our_vars : (context * string) list list ;
-    imported : ((context * string) * string) list ;
+    locally_imported : ((context * string) * string) list ;
     required_vars : (context * string * string) list ;
     current_package : per_package ;
     state : state ;
   }
 
 let anonymous_package_count = ref 0
-let default_state = { per_package = []; global_vars_declared = Hashtbl.create 256; global_vars_used = ref [] }
-let empty_exports = { export_ok = []; export_auto = []; export_tags = []; re_export_all = false }
+let default_state = { per_package = []; files_parsed = []; global_vars_declared = Hashtbl.create 256; global_vars_used = ref [] }
+let empty_exports = { export_ok = []; export_auto = []; export_tags = []; special_export = None }
 let ignored_packages = ref []
 
 let die_with_pos pos msg = failwith (Info.pos2sfull pos ^ msg)
 let warn_with_pos pos msg = prerr_endline (Info.pos2sfull pos ^ msg)
 
-let context2s = function
-  | I_scalar -> "$"
-  | I_hash -> "%"
-  | I_array -> "@"
-  | I_func -> "&"
-  | I_raw -> ""
-  | I_star -> "*"
-let variable2s(context, ident) = context2s context ^ ident
 let s2context s = 
   match s.[0] with
   | '$' -> I_scalar, skip_n_char 1 s
@@ -63,14 +60,22 @@ let s2context s =
 
 let get_current_package t =
   match t with
-  | Package(Ident _ as ident) :: _ -> 
-      Some (Parser_helper.string_of_Ident ident)
+  | Package(Ident _ as ident) :: body ->
+      let rec bundled_packages packages current_package found_body = function
+	| [] -> (Some current_package, List.rev found_body) :: packages
+	| Package(Ident _ as ident) :: body ->
+	    let packages = (Some current_package, List.rev found_body) :: packages in
+	    bundled_packages packages (string_of_Ident ident) [] body
+	| instr :: body ->
+	    bundled_packages packages current_package (instr :: found_body) body
+      in
+      bundled_packages [] (string_of_Ident ident) [] body
   | _ -> 
       if str_ends_with !Info.current_file ".pm" then warn_with_pos (!Info.current_file, 0, 0) (sprintf "module %s does not have \"package xxxx;\" on its first line" !Info.current_file) ;
-      None
+      [ None, t ]
 
 let from_qw = function
-  | Call_op("qw", [ Raw_string(s, pos)]) -> 
+  | Call_op("qw", [ Raw_string(s, pos)], _) -> 
       List.map (fun s -> 
 	let context, s' = s2context s in
 	let context =
@@ -88,20 +93,21 @@ let from_qw = function
 let get_exported t =
   List.fold_left (fun exports e ->
     match e with
-    | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", pos)); Call _ ]) ]
-    | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], pos);  Call _ ]) ] ->
-	if not exports.re_export_all then warn_with_pos pos "unrecognised @EXPORT" ;
+    | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", _)); Call _ ], pos) ]
+    | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], _);  Call _ ], pos) ] ->
+	if exports.special_export = None then warn_with_pos pos "unrecognised @EXPORT" ;
 	exports
 
-    | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", pos)); v ])]
-    | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], pos); v ])] ->
+    | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", _)); v ], pos)]
+    | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], _); v ], pos)] ->
 	if exports.export_auto <> [] then warn_with_pos pos "weird, @EXPORT set twice" ;
 	{ exports with export_auto = from_qw v }
 
-    | Perl_checker_comment("RE-EXPORT-ALL", _) -> { exports with re_export_all = true }
+    | Perl_checker_comment("RE-EXPORT-ALL", _) -> { exports with special_export = Some Re_export_all }
+    | Perl_checker_comment("EXPORT-ALL",    _) -> { exports with special_export = Some Export_all }
 
-    | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT_OK", pos)); v ])]
-    | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT_OK")], pos);  v ])] ->
+    | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT_OK", _)); v ], pos)]
+    | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT_OK")], _);  v ], pos)] ->
 	if exports.export_ok <> [] then warn_with_pos pos "weird, @EXPORT_OK set twice" ;
 	(match v with
 	| Call(Deref(I_func, Ident(None, "map", _)), 
@@ -110,8 +116,8 @@ let get_exported t =
 		   { exports with export_ok = collect snd exports.export_tags }
 	| _ -> { exports with export_ok = from_qw v })
 
-    | List [ Call_op("=", [ Deref(I_hash, Ident(None, "EXPORT_TAGS", pos)); v ])]
-    | List [ Call_op("=", [ My_our("our", [(I_hash, "EXPORT_TAGS")], pos);  v ])] ->
+    | List [ Call_op("=", [ Deref(I_hash, Ident(None, "EXPORT_TAGS", _)); v ], pos)]
+    | List [ Call_op("=", [ My_our("our", [(I_hash, "EXPORT_TAGS")], _);  v ], pos)] ->
 	(try
 	  let export_tags =
 	    match v with
@@ -147,9 +153,9 @@ let uses_external_package = function
 let get_uses t =
   List.fold_left (fun uses e ->
     match e with
-    | Use(Ident _ as pkg, _) when uses_external_package (Parser_helper.string_of_Ident pkg) -> uses
+    | Use(Ident _ as pkg, _) when uses_external_package (string_of_Ident pkg) -> uses
     | Use(Ident(_, _, pos) as ident, l) ->
-	let package = Parser_helper.string_of_Ident ident in
+	let package = string_of_Ident ident in
 	let para = if l = [] then None else Some(from_qw (List.hd l)) in
 	(package, (para, pos)) :: uses
     | _ -> uses
@@ -162,7 +168,7 @@ let get_vars_declaration state package =
     | Sub_declaration(Ident(Some fq, name, pos), _proto, _) ->
 	Hashtbl.replace state.global_vars_declared (I_func, fq, name) pos
 
-    | List [ Call_op("=", [My_our("our", ours, pos); _]) ]
+    | List [ Call_op("=", [My_our("our", ours, pos); _], _) ]
     | List [ My_our("our", ours, pos) ]
     | My_our("our", ours, pos) ->
 	List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) pos) ours
@@ -171,38 +177,71 @@ let get_vars_declaration state package =
     | Use(Ident(None, "vars", pos), [ours]) -> 
 	List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) pos) (from_qw ours)
     | Use(Ident(None, "vars", pos), _) -> 
-	die_with_pos pos "usage: \"use vars qw($var func)\""
+	die_with_pos pos "usage: use vars qw($var func)"
+
+    | List [ Method_call(Raw_string(pkg, pos), Raw_string("bootstrap", _), _) ] ->
+	if pkg <> package.package_name then
+	  warn_with_pos pos "strange bootstrap (the package name is not the same as the current package)"
+	else
+	  (try
+	    let cfile = Filename.chop_extension package.file_name ^ ".c" in
+	    let prefix = "newXS(\"" ^ pkg ^ "::" in
+	    ignore (fold_lines (fun in_bootstrap s ->
+	      if in_bootstrap then
+		(try
+		  let offset = strstr s prefix + String.length prefix in
+		  let end_ = String.index_from s offset '"' in
+		  let ident = String.sub s offset (end_ - offset) in
+		  match split_at2 ':'':' ident with
+		  | [_] -> Hashtbl.replace package.vars_declared (I_func, ident) pos
+		  | l -> 
+		      if l <> [] then
+			let fql, name = split_last l in
+			let fq = String.concat "::" (pkg :: fql) in
+			Hashtbl.replace state.global_vars_declared (I_func, fq, name) pos	
+		with Not_found -> ());
+	      in_bootstrap || str_contains s "XS_VERSION_BOOTCHECK"
+	    ) false (open_in cfile))
+	  with Invalid_argument _ | Sys_error _ -> ())
     | _ -> ()
   ) package.body
 
-let get_imports state package =
-  let rec get_one (package_name, (imports, pos)) =
-    try
-      let package_used = List.assoc package_name state.per_package in
-      let exports = package_used.exports in
-      match imports with
-      | None ->
-	  let re = if exports.re_export_all then collect get_one package_used.uses else [] in
-	  let l = List.map (fun (context, name) -> (context, name), package_name) exports.export_auto in
-	  re @ l
-      | Some l -> 
-	  let imports_vars = 
-	    collect (function
-	      | I_raw, tag -> 
-		  (try 
-		    List.assoc tag exports.export_tags
-		  with Not_found -> die_with_pos pos (sprintf "package %s doesn't export tag %s" package_name tag))
-	      | variable ->
-		  if List.mem variable exports.export_ok then
-		    [ variable ]
-		  else
-		    die_with_pos pos (sprintf "package %s doesn't export %s" package_name (variable2s variable))
-		    ) l
-	  in
-	  List.map (fun (context, name) -> (context, name), package_name) imports_vars
-    with Not_found -> []
-  in
-  collect get_one package.uses
+let rec get_imported state (package_name, (imports, pos)) =
+  try
+    let package_used = List.assoc package_name state.per_package in
+    let exports = package_used.exports in
+    match imports with
+    | None ->
+	let re = match exports.special_export with
+	| Some Re_export_all -> get_imports state package_used
+	| Some Export_all -> Hashtbl.fold (fun var _ l -> (var, package_name) :: l) package_used.vars_declared []
+	| _ -> [] in
+	let l = List.map (fun (context, name) -> (context, name), package_name) exports.export_auto in
+	re @ l
+    | Some l -> 
+	let imports_vars = 
+	  collect (function
+	    | I_raw, tag -> 
+		(try 
+		  List.assoc tag exports.export_tags
+		with Not_found -> die_with_pos pos (sprintf "package %s doesn't export tag %s" package_name tag))
+	    | variable ->
+		if List.mem variable exports.export_ok then
+		  [ variable ]
+		else
+		  die_with_pos pos (sprintf "package %s doesn't export %s" package_name (variable2s variable))
+		  ) l
+	in
+	List.map (fun (context, name) -> (context, name), package_name) imports_vars
+  with Not_found -> []
+
+and get_imports state package =
+  match !(package.imported) with
+  | Some l -> l
+  | None ->
+      let l = collect (get_imported state) package.uses in
+      package.imported := Some l ;
+      l
 
 let rec fold_tree f env e = 
   match f env e with
@@ -218,8 +257,7 @@ let rec fold_tree f env e =
        -> fold_tree_option f env e'
 
   | Sub_declaration(e1, _, e2)
-  | Deref_with(_, e1, e2)
-  | Binop(_, e1, e2)
+  | Deref_with(_, _, e1, e2)
        -> 
 	 let env = fold_tree f env e1 in
 	 let env = fold_tree f env e2 in
@@ -228,31 +266,20 @@ let rec fold_tree f env e =
   | Use(_, l)
   | List l
   | Block l
-  | Call_op(_, l)
+  | Call_op(_, l, _)
       -> List.fold_left (fold_tree f) env l
 
   | Call(e', l)
-  | CallP(e', l)
     -> 
       let env = fold_tree f env e' in
       List.fold_left (fold_tree f) env l
 
   | Method_call(e1, e2, l)
-  | Method_callP(e1, e2, l)
     ->
       let env = fold_tree f env e1 in
       let env = fold_tree f env e2 in
       List.fold_left (fold_tree f) env l
 
-  | If_then_else(_, t_l, e') 
-    -> 
-      let env = fold_tree_option f env e' in
-      List.fold_left (fun env (e1, e2) -> 
-	let env = fold_tree f env e1 in
-	let env = fold_tree f env e2 in
-	env
-      ) env t_l
-
   | _ -> env
 
 and fold_tree_option f env = function
@@ -261,45 +288,50 @@ and fold_tree_option f env = function
 
 
 let get_global_info_from_package t =
-  let exports = get_exported t in
-  let uses = get_uses t in
-  let current_package = get_current_package t in
-  let package_name =
-    match current_package with
-    | None -> 
-	if exports.export_ok <> [] || exports.export_auto <> [] || exports.export_tags <> [] then
-	  die_with_pos (!Info.current_file, 0, 0) "file with no \"package\" wants to export!"
-	else
-	  (incr anonymous_package_count ; sprintf "anonymous%d" !anonymous_package_count)
-    | Some name -> name
-  in
-  let required_packages = List.fold_left (fold_tree (fun l -> 
-    function
-      | Call(Deref(I_func, Ident (None, "require", pos)), [Raw_string (package, _)])
-	  when not (uses_external_package package) -> Some((package, pos) :: l)
-      | _ -> None)
-  ) [] t in
-  required_packages, { 
-    file_name = !Info.current_file ; 
-    package_name = package_name;
-    has_package_name = current_package <> None ;
-    exports = exports ;
-    vars_declared = Hashtbl.create 16 ;
-    uses = uses ;
-    body = t ;
-  }
-
+  let current_packages = get_current_package t in
+  map_withenv (fun required_packages (current_package, t) ->
+    let exports = get_exported t in
+    let uses = get_uses t in
+    let package_name =
+      match current_package with
+      | None -> 
+	  if exports.export_ok <> [] || exports.export_auto <> [] || exports.export_tags <> [] then
+	    die_with_pos (!Info.current_file, 0, 0) "file with no package name wants to export!"
+	  else
+	    (incr anonymous_package_count ; sprintf "anonymous%d" !anonymous_package_count)
+      | Some name -> name
+    in
+    let required_packages = List.fold_left (fold_tree (fun l -> 
+      function
+	| Call(Deref(I_func, Ident (None, "require", pos)), [Ident _ as pkg]) ->
+	    let package = string_of_Ident pkg in
+	    if uses_external_package package then None else Some((package, pos) :: l)
+	| _ -> None)
+      ) required_packages t in
+    { 
+      file_name = !Info.current_file ; 
+      package_name = package_name;
+      has_package_name = current_package <> None ;
+      exports = exports ;
+      imported = ref None ;
+      vars_declared = Hashtbl.create 16 ;
+      uses = uses ;
+      body = t ;
+    }, required_packages
+  ) [] current_packages
 
 let is_my_declared vars t = List.exists (List.exists ((=) t)) vars.my_vars
 let is_our_declared vars t = List.exists (List.exists ((=) t)) vars.our_vars
 let is_var_declared vars (context, name) = 
-  List.mem_assoc (context, name) vars.imported ||
+  List.mem_assoc (context, name) vars.locally_imported ||
+  List.mem_assoc (context, name) (get_imports vars.state vars.current_package) ||
   Hashtbl.mem vars.current_package.vars_declared (context, name)
 let is_global_var_declared vars (context, fq, name) =
   Hashtbl.mem vars.state.global_vars_declared (context, fq, name) ||
   (try
     let package = List.assoc fq vars.state.per_package in
-    Hashtbl.mem package.vars_declared (context, name)
+    Hashtbl.mem package.vars_declared (context, name) ||
+    List.mem_assoc (context, name) (get_imports vars.state package)
   with Not_found -> false)
 
  
@@ -358,7 +390,7 @@ let check_variable (context, var) vars =
       then ()
       else 
 	if context = I_func then 
-	  warn_with_pos pos ("unknown function " ^ Parser_helper.string_of_Ident var)
+	  warn_with_pos pos ("unknown function " ^ string_of_Ident var)
 	else
 	  lpush vars.state.global_vars_used ((context, fq, name), pos)
   | _ -> ()
@@ -366,12 +398,12 @@ let check_variable (context, var) vars =
 let declare_My vars (mys, pos) =
   let l_new = List.filter (fun (context, ident) ->
     if context = I_raw then
-      if ident = "undef" then false else die_with_pos pos (sprintf "bad ident \"%s\" in my" ident)
+      if ident = "undef" then false else die_with_pos pos (sprintf "bad ident %s in my" ident)
     else true
   ) mys in
   let l_pre = List.hd vars.my_vars in
   List.iter (fun v ->
-    if List.exists ((=) v) l_pre then warn_with_pos pos (sprintf "redeclared variable \"%s\"" (variable2s v))
+    if List.exists ((=) v) l_pre then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
   ) l_new ;
   { vars with my_vars = (l_new @ l_pre) :: List.tl vars.my_vars }
 
@@ -380,7 +412,7 @@ let declare_Our vars (ours, pos) =
   | [] -> vars (* we're at the toplevel, already declared in vars_declared *)
   | l_pre :: other ->
       List.iter (fun v ->
-	if List.exists ((=) v) l_pre then warn_with_pos pos (sprintf "redeclared variable \"%s\"" (variable2s v))
+	if List.exists ((=) v) l_pre then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
       ) ours ;
       { vars with our_vars = (ours @ l_pre) :: other }
 
@@ -405,11 +437,11 @@ let check_variables vars t =
 	let _vars' = List.fold_left check_variables_ vars' f in
 	Some vars
 
-    | Call_op("foreach my", [my; expr; Block block]) ->
+    | Call_op("foreach my", [my; expr; Block block], _) ->
 	let vars = check_variables_ vars expr in
 	let vars = check_variables_ vars (Block (my :: block)) in
 	Some vars
-    | Call_op(op, cond :: Block first_bl :: other) when op = "if" || op = "while" || op = "unless" || op = "until" ->
+    | Call_op(op, cond :: Block first_bl :: other, _) when op = "if" || op = "while" || op = "unless" || op = "until" ->
 	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
 	let vars' = check_variables_ vars' cond in
 	let _vars' = List.fold_left check_variables_ vars' first_bl in
@@ -417,7 +449,7 @@ let check_variables vars t =
 	Some vars
 
     | Sub_declaration(Ident(_, _, pos) as ident, _proto, body) ->
-	let vars = declare_Our vars ([ I_func, Parser_helper.string_of_Ident ident ], pos) in
+	let vars = declare_Our vars ([ I_func, string_of_Ident ident ], pos) in
 	let vars = check_variables_ vars body in
 	Some vars
 
@@ -429,31 +461,37 @@ let check_variables vars t =
     | Deref(context, (Ident _ as var)) -> 
 	check_variable (context, var) vars ;
 	Some vars
-    | Deref_with(context, (Ident _ as var), para) -> 
+    | Deref_with(context, _, (Ident _ as var), para) -> 
 	let vars = check_variables_ vars para in
 	check_variable (context, var) vars ;
 	Some vars
 
-    | Call_op(op, [My_our(my_or_our, mys, pos); e]) ->
-	if op = "=" then
-	  (* check e first *)
-	  let vars = check_variables_ vars e in
-	  List.iter (fun (context, var) ->
-	    if context = I_hash || context = I_array then die_with_pos pos (sprintf "%s takes all the arguments, %s is undef in any case" (variable2s (context, var)) (variable2s (last mys)))
-	  ) (removelast mys) ; (* mys is never empty *)
-	  Some(declare_My_our vars (my_or_our, mys, pos))
-	else
-	  (warn_with_pos pos "weird" ; None)
-
-    | Call(Deref(I_func, Ident(None, "require", _)), [Raw_string (package_name, _)]) ->
-	(try
-	  let package = List.assoc package_name vars.state.per_package in
-	  let required_vars = Hashtbl.fold (fun (context, ident) _ l -> 
-	    (context, vars.current_package.package_name, ident) :: l
-	  ) package.vars_declared vars.required_vars in
-	  let vars = { vars with required_vars = required_vars } in
-	  Some vars
-	with Not_found -> Some vars)
+    | Call_op("=", [My_our(my_or_our, mys, pos); e], _) ->
+	(* check e first *)
+	let vars = check_variables_ vars e in
+	List.iter (fun (context, var) ->
+	  if non_scalar_context context then die_with_pos pos (sprintf "%s takes all the arguments, %s is undef in any case" (variable2s (context, var)) (variable2s (last mys)))
+	) (removelast mys) ; (* mys is never empty *)
+	Some(declare_My_our vars (my_or_our, mys, pos))
+
+    | Call_op("if infix", [List [My_our _]; List [Num("0", _)]], _) -> None (* special allowed case *)
+    | Call_op(op, List (My_our _ :: _) :: _, pos) 
+    | Call_op(op, My_our _ :: _, pos)
+    | Call_op(op, Call_op("local", _, _) :: _, pos) ->
+	if op <> "=" then warn_with_pos pos (sprintf "applying %s on a new initialized variable is wrong" op);
+	None
+
+    | Call(Deref(I_func, Ident(None, "require", _)), [Ident _]) -> Some vars
+
+    | Method_call(Raw_string(package_name, pos), Raw_string ("import", _), para) ->
+	let args =
+	  match para with
+	  | [] -> None
+	  | [ List [v] ] -> Some(from_qw v)
+	  | _ -> die_with_pos pos "bad import statement" in
+	let l = get_imported vars.state (package_name, (args, pos)) in
+	let vars = { vars with locally_imported = l @ vars.locally_imported } in
+	Some vars
 	
     | _ -> None
   in
@@ -461,7 +499,28 @@ let check_variables vars t =
   vars
 
 let check_tree state package =
-  let imports = get_imports state package in
-  let vars = { my_vars = [[]]; our_vars = []; imported = imports; required_vars = []; current_package = package; state = state } in
+  let vars = { my_vars = [[]]; our_vars = []; locally_imported = []; required_vars = []; current_package = package; state = state } in
   let _vars = check_variables vars package.body in
   ()
+
+let add_package_to_state state package = 
+  let per_package =
+    try
+      update_assoc (fun existing_package ->
+	(*prerr_endline (existing_package.file_name ^ " vs " ^ package.file_name); *)
+	Hashtbl.iter (fun var pos -> Hashtbl.replace existing_package.vars_declared var pos) package.vars_declared ;
+	{ existing_package with
+	  body = existing_package.body @ package.body ;
+	  uses = existing_package.uses @ package.uses ;
+	  exports = { export_ok   = existing_package.exports.export_ok   @ package.exports.export_ok ;
+		      export_auto = existing_package.exports.export_auto @ package.exports.export_auto ;
+		      export_tags = existing_package.exports.export_tags @ package.exports.export_tags ;
+		      special_export = None }
+	}
+      ) package.package_name state.per_package
+  with Not_found ->
+    (package.package_name, package) :: state.per_package
+  in
+  { state with 
+    per_package = per_package ; 
+    files_parsed = package.file_name :: state.files_parsed }
diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli
index 769b513..71eeb04 100644
--- a/perl_checker.src/tree.mli
+++ b/perl_checker.src/tree.mli
@@ -1,10 +1,12 @@
 open Types
 
+type special_export = Re_export_all | Export_all
+
 type exports = {
   export_ok : (context * string) list;
   export_auto : (context * string) list;
   export_tags : (string * (context * string) list) list;
-  re_export_all : bool;
+  special_export : special_export option;
 } 
 
 
@@ -14,12 +16,14 @@ type per_package = {
     file_name : string ;
     package_name : string ; has_package_name : bool ;
     vars_declared : (context * string, pos) Hashtbl.t;
+    imported : ((context * string) * string) list option ref;
     exports : exports ;
     uses : uses ;
     body : fromparser list;
   }
 type state = {
     per_package : (string * per_package) list;
+    files_parsed : string list;
     global_vars_declared : (context * string * string, pos) Hashtbl.t;
     global_vars_used : ((context * string * string) * pos) list ref;
   } 
@@ -27,9 +31,10 @@ type state = {
 val ignored_packages : string list ref
 
 val default_state : state
-val get_global_info_from_package : fromparser list -> (string * pos) list * per_package
+val get_global_info_from_package : fromparser list -> per_package list * (string * pos) list
 val get_vars_declaration : state -> per_package -> unit
 val check_tree : state -> per_package -> unit
 
 val die_with_pos : string * int * int -> string -> 'a
 val warn_with_pos : string * int * int -> string -> unit
+val add_package_to_state : state -> per_package -> state
diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli
index d11ff9a..f69dc3d 100644
--- a/perl_checker.src/types.mli
+++ b/perl_checker.src/types.mli
@@ -22,20 +22,16 @@ type fromparser =
 
    | Ref of context * fromparser
    | Deref of context * fromparser
-   | Deref_with of context * fromparser * fromparser
+   | Deref_with of context * context * fromparser * fromparser (* from_context, to_context, ref, para *)
 
    | Diamond of fromparser option
-   | Binop of string * fromparser * fromparser
-   | If_then_else of string * (fromparser * fromparser) list * fromparser option
 
    | List of fromparser list
    | Block of fromparser list
 
-   | Call_op of string * fromparser list
+   | Call_op of string * fromparser list * pos
    | Call of fromparser * fromparser list
-   | CallP of fromparser * fromparser list
    | Method_call of fromparser * fromparser * fromparser list
-   | Method_callP of fromparser * fromparser * fromparser list
 
    | Anonymous_sub of fromparser
    | My_our of string * (context * string) list * pos