summaryrefslogtreecommitdiffstats
path: root/perl_checker.src/parser_helper.ml
diff options
context:
space:
mode:
Diffstat (limited to 'perl_checker.src/parser_helper.ml')
-rw-r--r--perl_checker.src/parser_helper.ml177
1 files changed, 86 insertions, 91 deletions
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index 9eca21a..cfe3c9e 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -343,6 +343,30 @@ let sp_same esp1 esp2 =
if esp1.spaces <> Space_0 then sp_p esp2
else if esp2.spaces <> Space_0 then sp_p esp1
+let function_to_context = function
+ | "map" | "grep" | "grep_index" | "map_index" -> M_array
+ | "partition" -> M_tuple [ M_ref M_array ; M_ref M_array ]
+ | "find" -> M_unknown_scalar
+ | "any" | "every" -> M_bool
+ | "find_index" -> M_int
+ | "each_index" -> M_none
+ | "N" | "N_" -> M_string
+
+ | "chop" | "chomp" -> M_none
+ | "hex" | "length" | "time" | "fork" | "getppid" -> M_int
+ | "eof" | "wantarray" -> M_int
+ | "stat" | "lstat" -> M_list
+ | "arch" | "quotemeta" | "join" | "lc" | "lcfirst" | "uc" | "ucfirst" -> M_string
+
+ | "split" -> M_array
+ | "shift" | "pop" -> M_unknown_scalar
+ | "die" | "return" | "redo" | "next" | "last" -> M_unknown
+ | "caller" -> M_mixed [M_string ; M_list]
+ | "undef" -> M_undef
+
+ | "ref" -> M_ref M_unknown_scalar
+ | _ -> M_unknown
+
let word_alone esp =
let word = esp.any in
let mcontext, e = match word with
@@ -365,22 +389,7 @@ let word_alone esp =
Deref(I_func, word)
| _ -> word
in
- let mcontext = match f with
- | "chop" | "chomp" -> M_none
- | "hex" | "length" | "time" | "fork" | "getppid" -> M_int
- | "eof" | "wantarray" -> M_int
- | "stat" | "lstat" -> M_list
- | "arch" | "quotemeta" | "join" | "lc" | "lcfirst" | "uc" | "ucfirst" -> M_string
-
- | "split" -> M_array
- | "shift" | "pop" -> M_scalar
- | "die" | "return" | "redo" | "next" | "last" -> M_unknown
- | "caller" -> M_mixed [M_string ; M_list]
- | "undef" -> M_undef
-
- | "ref" -> M_ref M_scalar
- | _ -> M_unknown
- in mcontext, e
+ function_to_context f, e
| _ -> M_unknown, word
in
new_pesp mcontext P_tok e esp esp
@@ -919,15 +928,7 @@ let check_return esp_func esp_para =
let call_and_context(e, para) force_non_builtin_func priority esp_start esp_end =
let context =
match e with
- | Deref(I_func, Ident(None, f, _)) ->
- (match f with
- | "map" | "grep" | "grep_index" | "map_index" | "partition" -> M_list
- | "find" -> M_scalar
- | "any" | "every" -> M_scalar
- | "find_index" -> M_int
- | "each_index" -> M_none
- | "N" | "N_" -> M_string
- | _ -> M_unknown)
+ | Deref(I_func, Ident(None, f, _)) -> function_to_context f
| _ -> M_unknown
in
new_pesp context priority (call_raw force_non_builtin_func (e, para)) esp_start esp_end
@@ -1047,7 +1048,7 @@ let rec mcontext2s = function
| M_revision -> "revision"
| M_undef -> "undef"
| M_sub -> "sub"
- | M_scalar -> "scalar"
+ | M_unknown_scalar -> "scalar"
| M_tuple l -> "tuple(" ^ String.concat ", " (List.map mcontext2s l) ^ ")"
| M_list -> "list"
@@ -1058,62 +1059,68 @@ let rec mcontext2s = function
| M_unknown -> "unknown"
| M_mixed l -> String.concat " | " (List.map mcontext2s l)
-let mcontext_is_scalar = function
- | M_int | M_float | M_string | M_ref _ | M_revision | M_undef
- | M_scalar | M_array -> true
- | _ -> false
-
let rec mcontext_lower c1 c2 =
match c1, c2 with
| M_special, _ | _, M_special -> internal_error "M_special in mcontext_compare"
- | M_array, M_array | M_array, M_int | M_array, M_float | M_array, M_scalar | M_array, M_tuple _ | M_array, M_list
- | M_hash, M_hash | M_hash, M_scalar | M_hash, M_tuple _ | M_hash, M_list
+ | M_unknown, _
+ | _, M_unknown -> true
- | M_bool, M_bool | M_bool, M_scalar | M_bool, M_list
+ | M_none, M_none | M_sub, M_sub | M_hash, M_hash -> true
+ | M_none, _ | M_sub, _ | M_hash, _ -> false
- | M_int, M_int | M_int, M_float | M_int, M_string | M_int, M_scalar | M_int, M_list
- | M_float, M_float | M_float, M_string | M_float, M_scalar | M_float, M_list
- | M_ref _, M_scalar | M_ref _, M_list
- | M_string, M_string | M_string, M_scalar | M_string, M_list
- | M_revision, M_revision | M_revision, M_scalar | M_revision, M_list
- | M_undef, M_undef | M_undef, M_scalar | M_undef, M_list
- | M_scalar, M_scalar | M_scalar, M_list
- -> true
+ | _, M_list -> true
- | M_bool, M_tuple (c :: _) | M_int, M_tuple (c :: _) | M_float, M_tuple (c :: _) | M_ref _, M_tuple (c :: _) | M_string, M_tuple (c :: _) | M_revision, M_tuple (c :: _) | M_scalar, M_tuple (c :: _)
- -> mcontext_lower c1 c
+ | M_list, M_bool
- | M_tuple t1, M_tuple t2 ->
- List.length t1 <= List.length t2 && for_all2_true mcontext_lower t1 t2
- | M_tuple _, M_list
+ (* M_unknown_scalar is M_mixed [ M_int ; M_float ; M_string ; M_bool ; M_ref _ ; M_revision ; M_undef ] *)
+ | M_unknown_scalar, M_int | M_unknown_scalar, M_float | M_unknown_scalar, M_string | M_unknown_scalar, M_bool
+ | M_unknown_scalar, M_ref _ | M_unknown_scalar, M_revision | M_unknown_scalar, M_undef | M_unknown_scalar, M_unknown_scalar
- | M_list, M_list
- | M_none, M_none
- | M_sub, M_sub
+ | M_array, M_array | M_array, M_int | M_array, M_float | M_array, M_bool | M_array, M_unknown_scalar | M_array, M_tuple _
+ | M_int, M_int | M_int, M_float | M_int, M_string | M_int, M_bool | M_int, M_unknown_scalar
+ | M_float, M_float | M_float, M_string | M_float, M_bool | M_float, M_unknown_scalar
+ | M_string, M_string | M_string, M_bool | M_string, M_unknown_scalar
+ | M_bool, M_bool | M_bool, M_unknown_scalar
- | _, M_unknown
+ | M_ref _, M_unknown_scalar
+ | M_revision, M_revision | M_revision, M_unknown_scalar
+ | M_undef, M_undef | M_undef, M_unknown_scalar
-> true
- | M_ref a, M_ref b -> mcontext_lower a b
- | c, M_mixed l -> List.exists (mcontext_lower c) l
+ | M_tuple t1, M_tuple t2 ->
+ List.length t1 <= List.length t2 && for_all2_true mcontext_lower t1 t2
+
+ | M_int, M_tuple (c :: _) | M_float, M_tuple (c :: _) | M_string, M_tuple (c :: _) | M_bool, M_tuple (c :: _)
+ | M_ref _, M_tuple (c :: _) | M_revision, M_tuple (c :: _) | M_undef, M_tuple (c :: _) | M_unknown_scalar, M_tuple (c :: _)
+ -> mcontext_lower c1 c
+
+(* | M_ref a, M_ref b -> mcontext_lower a b *)
+
+(* | c, M_mixed l -> List.exists (mcontext_lower c) l*)
| M_mixed l, c -> List.exists (fun a -> mcontext_lower a c) l
| _ -> false
+let mcontext_is_scalar = function
+ | M_unknown -> false
+ | c -> mcontext_lower c M_unknown_scalar
+
+let mcontext_to_scalar = function
+ | M_array -> M_int
+ | c -> if mcontext_is_scalar c then c else M_unknown_scalar
+
let mcontext_merge_raw c1 c2 =
match c1, c2 with
| M_unknown, _ | _, M_unknown -> Some M_unknown
| M_mixed _, _ | _, M_mixed _ -> internal_error "mcontext_merge_raw"
| _ ->
- (*
if mcontext_lower c1 c2 then Some c2 else
if mcontext_lower c2 c1 then Some c1 else
- *)
if c1 = c2 then Some c1 else
if mcontext_is_scalar c1 && mcontext_is_scalar c2
- then Some M_scalar
+ then Some M_unknown_scalar
else None
let rec mcontext_lmerge_add l = function
@@ -1138,48 +1145,24 @@ let mcontext_merge c1 c2 = mcontext_lmerge [ c1 ; c2 ]
let mcontext_lmaybe esp = if esp.any = [] then [] else [esp.mcontext]
-let mcontext_check_raw wanted_mcontext esp f_lower f_greater f_err =
- if mcontext_lower esp.mcontext wanted_mcontext then
- f_lower()
- else if mcontext_lower wanted_mcontext esp.mcontext then
- f_greater()
- else
- (warn_rule (sprintf "context %s is not compatible with context %s" (mcontext2s esp.mcontext) (mcontext2s wanted_mcontext));
- f_err())
+let mcontext_check_raw wanted_mcontext mcontext =
+ if not (mcontext_lower mcontext wanted_mcontext) then
+ warn_rule (sprintf "context %s is not compatible with context %s" (mcontext2s mcontext) (mcontext2s wanted_mcontext))
let mcontext_check wanted_mcontext esp =
(match wanted_mcontext with
| M_list | M_array | M_mixed [M_array; M_none] | M_tuple _ -> ()
| _ ->
match un_parenthesize_full esp.any.expr with
- | Call(Deref(I_func, Ident(None, "grep", _)), _) -> warn_rule "in boolean context, use \"any\" instead of \"grep\""
+ | Call(Deref(I_func, Ident(None, "grep", _)), _) ->
+ warn_rule (if wanted_mcontext = M_bool then
+ "in boolean context, use \"any\" instead of \"grep\"" else
+ "you may use \"find\" instead of \"grep\"")
| _ -> ());
- mcontext_check_raw wanted_mcontext esp (fun () -> ()) (fun () -> ()) (fun () -> ())
-
-let mcontext_symops wanted_mcontext esp1 esp2 =
- mcontext_check_raw wanted_mcontext esp1
- (fun () ->
- mcontext_check_raw wanted_mcontext esp2
- (fun () ->
- match mcontext_merge esp1.mcontext esp2.mcontext with
- | M_array when mcontext_is_scalar wanted_mcontext -> M_int (* don't allow @a + @b to return M_array *)
- | r -> r)
- (fun () -> mcontext_merge esp1.mcontext wanted_mcontext)
- (fun () -> wanted_mcontext))
- (fun () ->
- mcontext_check_raw wanted_mcontext esp2
- (fun () -> mcontext_merge wanted_mcontext esp2.mcontext)
- (fun () -> wanted_mcontext)
- (fun () -> wanted_mcontext))
- (fun () -> wanted_mcontext)
-
-let mcontext_rightops wanted_mcontext esp1 esp2 =
- mcontext_check wanted_mcontext esp1 ;
- mcontext_check_raw wanted_mcontext esp2 (fun () -> esp2.mcontext) (fun () -> wanted_mcontext) (fun () -> wanted_mcontext)
-
-let mcontext_unop wanted_mcontext esp = mcontext_check wanted_mcontext esp ; wanted_mcontext
-
-let mcontext_unop_l wanted_mcontext esp = mcontext_unop wanted_mcontext { esp with any = { esp.any with expr = List esp.any.expr } }
+ mcontext_check_raw wanted_mcontext esp.mcontext
+
+let mcontext_check_unop_l wanted_mcontext esp =
+ mcontext_check wanted_mcontext { esp with any = { esp.any with expr = List esp.any.expr } }
let mcontext_check_non_none esp =
if esp.mcontext = M_none then warn_rule "() context not accepted here"
@@ -1209,6 +1192,12 @@ let mcontext_check_none msg expr esp =
in
mcontext_check_none_rec msg expr esp.mcontext
+let mcontext_float_or_int l =
+ List.fold_left (fun c1 c2 ->
+ if c1 = M_int && c2 = M_int then M_int else
+ (mcontext_check_raw M_float c2 ; M_float)
+ ) M_int l
+
let mcontext_op_assign left right =
mcontext_check_non_none right;
let left_context =
@@ -1234,3 +1223,9 @@ let mtuple_context_concat c1 c2 =
| M_hash, _ | _, M_hash -> M_list
| M_tuple l, _ -> M_tuple (l @ [c2])
| _ -> M_tuple [c1 ; c2]
+
+let symops pri para_context return_context op_str left op right =
+ sp_same op right;
+ mcontext_check para_context left ;
+ mcontext_check para_context right ;
+ to_Call_op_ return_context pri op_str [prio_lo pri left; prio_lo_after pri right] left right