diff options
Diffstat (limited to 'perl_checker.src/parser_helper.ml')
| -rw-r--r-- | perl_checker.src/parser_helper.ml | 119 |
1 files changed, 75 insertions, 44 deletions
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index c97c51d..ed89c8d 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -5,7 +5,8 @@ open Printf let bpos = -1, -1 let raw_pos2pos(a, b) = !Info.current_file, a, b -let pos_range (_, (space, (a1, b1))) (_, (_, (a2, b2))) = space, ((if a1 = -1 then a2 else a1), (if b2 = -1 then b1 else b2)) +let pos_range (_, (_, (a1, b1))) (_, (_, (a2, b2))) = raw_pos2pos((if a1 = -1 then a2 else a1), (if b2 = -1 then b1 else b2)) +let sp_pos_range (_, (space, (a1, b1))) (_, (_, (a2, b2))) = space, ((if a1 = -1 then a2 else a1), (if b2 = -1 then b1 else b2)) 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)) @@ -39,19 +40,29 @@ let string_of_Ident = function | Ident(Some fq, s, _) -> fq ^ "::" ^ s | _ -> internal_error "string_of_Ident" +let from_scalar (e, _) = + match e with + | Deref(I_scalar, ident) -> ident + | _ -> internal_error "from_scalar" + +let from_array (e, _) = + match e with + | Deref(I_array, ident) -> ident + | _ -> internal_error "from_array" -let msg_with_pos (start, end_) msg = Info.pos2sfull_current start end_ ^ msg -let die_with_pos raw_pos msg = failwith (msg_with_pos raw_pos msg) -let warn raw_pos msg = prerr_endline (msg_with_pos raw_pos msg) +let msg_with_rawpos (start, end_) msg = Info.pos2sfull_current start end_ ^ msg +let die_with_rawpos raw_pos msg = failwith (msg_with_rawpos raw_pos msg) +let warn raw_pos msg = prerr_endline (msg_with_rawpos raw_pos msg) -let die_rule msg = die_with_pos (Parsing.symbol_start(), Parsing.symbol_end()) msg +let die_rule msg = die_with_rawpos (Parsing.symbol_start(), Parsing.symbol_end()) msg let warn_rule msg = warn (Parsing.symbol_start(), Parsing.symbol_end()) msg let debug msg = if true then prerr_endline msg -let warn_too_many_space start = warn (start, start) "you should have only one space here" -let warn_no_space start = warn (start, start) "you should have a space here" -let warn_cr start = warn (start, start) "you should not have a carriage-return (\\n) here" -let warn_space start = warn (start, start) "you should not have a space here" +let warn_verb pos msg = if not !Flags.quiet then warn (pos, pos) msg +let warn_too_many_space start = warn_verb start "you should have only one space here" +let warn_no_space start = warn_verb start "you should have a space here" +let warn_cr start = warn_verb start "you should not have a carriage-return (\\n) here" +let warn_space start = warn_verb start "you should not have a space here" let rec prio_less = function | P_paren_wanted prio1, prio2 @@ -161,7 +172,7 @@ let sp_cr(_, (spaces, (start, _))) = | Space_none -> () | Space_0 | Space_1 - | Space_n -> warn (start, start) "you should have a carriage-return (\\n) here" + | Space_n -> warn_verb start "you should have a carriage-return (\\n) here" | Space_cr -> () let sp_same (_, (spaces1, _) as ter1) (_, (spaces2, _) as ter2) = @@ -169,8 +180,11 @@ let sp_same (_, (spaces1, _) as ter1) (_, (spaces2, _) as ter2) = else if spaces2 <> Space_0 then sp_p ter1 let check_word_alone (word, _) = - let s = string_of_Ident word in - if s = "time" || s = "wantarray" then die_rule (sprintf "please use %s() instead of %s" s s); + (match word with + | Ident(None, ("time" as f), _) + | Ident(None, ("wantarray" as f), _) -> + die_rule (sprintf "please use %s() instead of %s" f f) + | _ -> ()); word let check_parenthesized_first_argexpr word ((_, e), (_, (start, _)) as ex) = @@ -181,26 +195,22 @@ let check_parenthesized_first_argexpr word ((_, e), (_, (start, _)) as ex) = | e' :: l -> if is_parenthesized e' then if want_space then - if l = [] then sp_n(ex) else die_with_pos (start, start) "can't handle this nicely" + 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_pos (start, start) "you must not have a space here" + if l = [] then sp_0(ex) else die_with_rawpos (start, start) "you must not have a space here" | _ -> 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_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_package t = - if str_ends_with !Info.current_file ".pm" then - match t with - | Package _ :: _ -> () - | _ -> warn (0, 0) (sprintf "module %s does not have \"package xxxx;\" on its first line" !Info.current_file) - -let check_my op para (_, pos) = +let check_my_our op para (_, pos) = match op, para with - | "=", [List [My _]; Ident(None, "undef", _)] -> warn pos "no need to initialize variable, it's done by default" - | "=", [List [My _]; List[]] -> + | "=", [List [My_our _]; Ident(None, "undef", _)] -> warn pos "no need to initialize variable, it's done by default" + | "=", [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" | _ -> () @@ -212,7 +222,7 @@ let check_block_sub (l, (_, (_, end_)) as ter_lines) (_, (space, _) as ter_BRACK sp_p ter_BRACKET_END ; if space <> Space_cr then - (if l <> [] && last l = Semi_colon then warn (end_, end_) "spurious \";\" before closing block") + (if l <> [] && last l = Semi_colon then warn_verb end_ "spurious \";\" before closing block") ) let check_block_ref (l, (_, (_, end_)) as ter_lines) (_, (space, _) as ter_BRACKET_END) = @@ -221,42 +231,63 @@ let check_block_ref (l, (_, (_, end_)) as ter_lines) (_, (space, _) as ter_BRACK else sp_same ter_lines ter_BRACKET_END ; if space <> Space_cr then - (if l <> [] && last l = Semi_colon then warn (end_, end_) "spurious \";\" before closing block") - + (if l <> [] && last l = Semi_colon then warn_verb end_ "spurious \";\" before closing block") -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 op prio s (_, both) = prio, (((), both), s) -let op_p prio s e = sp_p e ; op prio s e - -let call_op((prio, (prev_ter, op)), ter, para) = - sp_same prev_ter ter ; - check_my op para (snd ter); - prio, Call_op(op, para) +let check_my_our_paren (((comma_closed, _), _), _) = + if not comma_closed then die_rule "syntax error" let rec only_one (l, (spaces, pos)) = match l with | [List l'] -> only_one (l', (spaces, pos)) | [e] -> e - | [] -> die_with_pos pos "you must give one argument" - | _ -> die_with_pos pos "you must give only one argument" + | [] -> die_with_rawpos pos "you must give one argument" + | _ -> die_with_rawpos pos "you must give only one argument" let only_one_in_List ((_, e), both) = match e with | List l -> only_one(l, both) | _ -> e - -let array_ident_to_hash_ident (e, (_, pos)) = - match e with - | Deref(I_array, e) -> Deref(I_hash, e) - | _ -> die_with_pos pos "internal error (array_ident_to_hash_ident)" let to_List = function | [e] -> e | l -> List l -let sub_declaration (name, proto) body = Sub_declaration(name, proto, body) +let deref_arraylen e = Call(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_Local ((_, e), (_, pos)) = + let l = + match e with + | List[List l] -> l + | _ -> [e] + in + let local_vars, local_exprs = fpartition (function + | Deref(I_star, Ident(None, ident, _)) -> + Some(I_star, ident) + | 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 _), _), _) -> + None + | _ -> die_with_rawpos pos "bad argument to \"local\"" + ) l in + if local_vars = [] then Call_op("local", local_exprs) + else if local_exprs = [] then My_our("local", local_vars, raw_pos2pos pos) + else die_with_rawpos pos "bad argument to \"local\"" + +let op prio s (_, both) = prio, (((), both), s) +let op_p prio s e = sp_p e ; op prio s e + +let call_op((prio, (prev_ter, op)), ter, para) = + sp_same prev_ter ter ; + check_my_our op para (snd ter); + prio, Call_op(op, para) + +let sub_declaration (name, proto) body = Sub_declaration(name, proto, Block body) +let anonymous_sub body = Anonymous_sub (Block body) let call(e, para) = (match e with |