summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2002-11-24 00:07:31 +0000
committerPascal Rigaux <pixel@mandriva.com>2002-11-24 00:07:31 +0000
commit9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4 (patch)
tree683175dc3f892806f31ff2120b1b5ed818c038ef
parent311a8f18e0dbdddf23f0c52c3a6da76926e556fb (diff)
downloadperl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.tar
perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.tar.gz
perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.tar.bz2
perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.tar.xz
perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.zip
*** empty log message ***
Diffstat
-rw-r--r--perl_checker.src/.cvsignore14
-rw-r--r--perl_checker.src/Makefile4
-rw-r--r--perl_checker.src/common.ml62
-rw-r--r--perl_checker.src/common.mli10
-rw-r--r--perl_checker.src/flags.ml5
-rw-r--r--perl_checker.src/flags.mli3
-rw-r--r--perl_checker.src/info.ml11
-rw-r--r--perl_checker.src/info.mli1
-rw-r--r--perl_checker.src/lexer.mll45
-rw-r--r--perl_checker.src/parser.mly345
-rw-r--r--perl_checker.src/parser_helper.ml119
-rw-r--r--perl_checker.src/parser_helper.mli29
-rw-r--r--perl_checker.src/perl_checker.ml83
-rw-r--r--perl_checker.src/tree.ml424
-rw-r--r--perl_checker.src/tree.mli32
-rw-r--r--perl_checker.src/types.mli11
16 files changed, 925 insertions, 273 deletions
diff --git a/perl_checker.src/.cvsignore b/perl_checker.src/.cvsignore
index 9d76706..d715755 100644
--- a/perl_checker.src/.cvsignore
+++ b/perl_checker.src/.cvsignore
@@ -1,9 +1,13 @@
-.depend
-perl_checker
-perl_checker_debug
-gmon.out
+._bcdi
+._d
+._ncdi
*.cmi
*.cmo
*.cmx
+perl_checker
+perl_checker_debug
+gmon.out
+lexer.ml
parser.ml
-parser.output \ No newline at end of file
+parser.mli
+parser.output
diff --git a/perl_checker.src/Makefile b/perl_checker.src/Makefile
index 9f66e4a..9b33410 100644
--- a/perl_checker.src/Makefile
+++ b/perl_checker.src/Makefile
@@ -4,7 +4,7 @@ YFLAGS = -v
TRASH = parser.output TAGS
RESULT = perl_checker
BCSUFFIX = _debug
-SOURCES = common.ml types.mli info.ml parser_helper.ml parser.mly lexer.mll perl_checker.ml
+SOURCES = common.ml flags.ml types.mli info.ml parser_helper.ml parser.mly lexer.mll tree.ml perl_checker.ml
LIBS = unix
NAME = shyant
@@ -17,4 +17,4 @@ tags:
TAGS:
ocamltags *.ml
--include OCamlMakefile \ No newline at end of file
+-include OCamlMakefile
diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml
index c4600ff..439c460 100644
--- a/perl_checker.src/common.ml
+++ b/perl_checker.src/common.ml
@@ -37,7 +37,9 @@ let has_env var =
let _ = Sys.getenv var in true
with Not_found -> false
-let some = function Some e -> e | None -> failwith "some"
+let some = function
+ | Some e -> e
+ | None -> failwith "some"
let some_or = function
| None -> id
@@ -185,6 +187,12 @@ let rec stack2list s =
let l = ref [] in
Stack.iter (fun e -> l := e :: !l) s ;
!l
+
+let rec stack_exists f s =
+ try
+ Stack.iter (fun e -> if f e then raise Found) s ;
+ false
+ with Found -> true
let rec queue2list q = rev (Queue.fold (fun b a -> a :: b) [] q)
@@ -200,6 +208,11 @@ let rec fix_point_ nb f p =
let p' = f p in
if p = p' then p, nb else fix_point_ (nb+1) f p'
+let rec group_by_2 = function
+ | [] -> []
+ | a :: b :: l -> (a, b) :: group_by_2 l
+ | _ -> failwith "group_by_2"
+
(*
let rec lfix_point f e =
let e' = f(e) in
@@ -647,6 +660,10 @@ let chomps s =
while !i >= 0 && (s.[!i] = ' ' || s.[!i] = '\t') do decr i done ;
String.sub s 0 (!i+1)
+let rec times e = function
+ | 0 -> []
+ | n -> e :: times e (n-1)
+
let skip_n_char_ beg end_ s =
String.sub s beg (String.length s - beg - end_)
let skip_n_char n s = skip_n_char_ n 0 s
@@ -668,12 +685,43 @@ let is_lowercase c = Char.uppercase c <> c
let starts_with_non_lowercase s = s <> "" && s.[0] <> '_' && not (is_lowercase s.[0])
-let get_package_name s =
- try Some (String.sub s 0 (String.rindex s ':' - 1)) with Not_found -> None
-
-let split_at_two_colons s =
- let i_fq = String.rindex s ':' in
- String.sub s 0 (i_fq - 1), skip_n_char (i_fq + 1) s
+let rec fold_lines f init chan =
+ try
+ let line = input_line chan in
+ fold_lines f (f init line) chan
+ with End_of_file -> init
+let readlines chan = List.rev (fold_lines (fun l e -> e::l) [] chan)
+
+let split_at c s =
+ let rec split_at_ accu i =
+ try
+ let i' = String.index_from s i c in
+ split_at_ (String.sub s i (i' - i) :: accu) (i'+1)
+ with Not_found -> rev (skip_n_char i s :: accu)
+ in
+ split_at_ [] 0
+
+let split_at2 c1 c2 s =
+ let rec split_at2_ accu i i2 =
+ try
+ let i3 = String.index_from s i2 c1 in
+ if s.[i3+1] = c2 then split_at2_ (String.sub s i (i3 - i) :: accu) (i3+2) (i3+2) else
+ split_at2_ accu i i3
+ with Not_found | Invalid_argument _ -> rev (skip_n_char i s :: accu)
+ in
+ split_at2_ [] 0 0
+
+let words s =
+ let rec words_ accu i =
+ try
+ let i2 = non_index_from s i ' ' in
+ try
+ let i3 = String.index_from s i2 ' ' in
+ words_ (String.sub s i2 (i3 - i2) :: accu) (i3+1)
+ with Not_found -> rev (skip_n_char i2 s :: accu)
+ with Invalid_argument _ -> rev accu
+ in
+ words_ [] 0
let to_CamelCase s_ =
let l = ref [] in
diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli
index 5398092..1e8078b 100644
--- a/perl_checker.src/common.mli
+++ b/perl_checker.src/common.mli
@@ -42,10 +42,12 @@ val fold_right1 : ('a -> 'a -> 'a) -> 'a list -> 'a
val for_all2_ : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
val maxl : 'a list -> 'a
val stack2list : 'a Stack.t -> 'a list
+val stack_exists : ('a -> bool) -> 'a Stack.t -> bool
val queue2list : 'a Queue.t -> 'a list
val fix_point : ('a -> 'a) -> 'a -> 'a
val fix_point_withenv : ('a -> 'b -> 'b * 'a) -> 'a -> 'b -> 'b * 'a
val fix_point_ : int -> ('a -> 'a) -> 'a -> 'a * int
+val group_by_2 : 'a list -> ('a * 'a) list
val do0_withenv :
(('a -> unit) -> 'b -> 'c) -> ('d -> 'a -> 'd) -> 'd -> 'b -> 'd
val do0_withenv2 :
@@ -176,6 +178,7 @@ val str_contains : string -> string -> bool
val str_ends_with : string -> string -> bool
val chop : string -> string
val chomps : string -> string
+val times : 'a -> int -> 'a list
val skip_n_char_ : int -> int -> string -> string
val skip_n_char : int -> string -> string
val non_index_from : string -> int -> char -> int
@@ -186,8 +189,11 @@ val explode_string : string -> char list
val is_uppercase : char -> bool
val is_lowercase : char -> bool
val starts_with_non_lowercase : string -> bool
-val get_package_name : string -> string option
-val split_at_two_colons : string -> string * string
+val fold_lines : ('a -> string -> 'a) -> 'a -> in_channel -> 'a
+val readlines : in_channel -> string list
+val split_at : char -> string -> string list
+val split_at2 : char -> char -> string -> string list
+val words : string -> string list
val to_CamelCase : string -> string option
val string_of_ref : 'a ref -> string
val is_int : float -> bool
diff --git a/perl_checker.src/flags.ml b/perl_checker.src/flags.ml
index e69de29..b2c40c2 100644
--- a/perl_checker.src/flags.ml
+++ b/perl_checker.src/flags.ml
@@ -0,0 +1,5 @@
+open Common
+
+let verbose = ref false
+let quiet = ref false
+
diff --git a/perl_checker.src/flags.mli b/perl_checker.src/flags.mli
index 8b13789..9f17f55 100644
--- a/perl_checker.src/flags.mli
+++ b/perl_checker.src/flags.mli
@@ -1 +1,2 @@
-
+val verbose : bool ref
+val quiet : bool ref
diff --git a/perl_checker.src/info.ml b/perl_checker.src/info.ml
index d15d3c0..947dc50 100644
--- a/perl_checker.src/info.ml
+++ b/perl_checker.src/info.ml
@@ -2,18 +2,21 @@ open List
open Printf
open Common
-let (lines_starts : (string * int list ref) list ref) = ref []
+let (lines_starts : (string, int list) Hashtbl.t) = Hashtbl.create 4
let current_file_lines_starts = ref []
let current_file_current_line = ref 0
let current_file = ref ""
let start_a_new_file file =
+ if !current_file <> "" then Hashtbl.add lines_starts !current_file !current_file_lines_starts ;
current_file := file ;
- current_file_lines_starts := [0] ;
- lines_starts := (file, current_file_lines_starts) :: !lines_starts
+ current_file_lines_starts := [0]
+
+let get_lines_starts_for_file file =
+ if file = !current_file then !current_file_lines_starts else Hashtbl.find lines_starts file
let raw_pos2raw_line file a =
- let starts = map_index (fun a b -> a,b) (rev !(assoc file !lines_starts)) in
+ let starts = map_index (fun a b -> a,b) (rev (get_lines_starts_for_file file)) in
let ((offset, line), _) = find (fun (_,(e,_)) -> e > a) (combine starts (tl starts @ [999999999, 999999999])) in
line, offset
diff --git a/perl_checker.src/info.mli b/perl_checker.src/info.mli
index 6796a62..4082306 100644
--- a/perl_checker.src/info.mli
+++ b/perl_checker.src/info.mli
@@ -1,4 +1,3 @@
-val lines_starts : (string * int list ref) list ref
val current_file_lines_starts : int list ref
val current_file_current_line : int ref
val current_file : string ref
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll
index 3ebce72..e54e968 100644
--- a/perl_checker.src/lexer.mll
+++ b/perl_checker.src/lexer.mll
@@ -18,7 +18,7 @@ type raw_token =
| BAREWORD of (string * raw_pos)
| BAREWORD_PAREN of (string * raw_pos)
| REVISION of (string * raw_pos)
- | COMMENT of (string * raw_pos)
+ | PERL_CHECKER_COMMENT of (string * raw_pos)
| POD of (string * raw_pos)
| LABEL of (string * raw_pos)
| COMMAND_STRING of (raw_interpolated_string * raw_pos)
@@ -38,7 +38,7 @@ type raw_token =
| ARRAYLEN_IDENT of (string option * string * raw_pos)
| FUNC_DECL_WITH_PROTO of (string * string * raw_pos)
- | IF of raw_pos | ELSIF of raw_pos | ELSE of raw_pos | UNLESS of raw_pos | DO of raw_pos | WHILE of raw_pos | UNTIL of raw_pos | MY of raw_pos | CONTINUE of raw_pos | SUB of raw_pos
+ | IF of raw_pos | ELSIF of raw_pos | ELSE of raw_pos | UNLESS of raw_pos | DO of raw_pos | WHILE of raw_pos | UNTIL of raw_pos | MY_OUR of (string * raw_pos) | CONTINUE of raw_pos | SUB of raw_pos
| LOCAL of raw_pos | FOR of (string * raw_pos) | USE of raw_pos | PACKAGE of raw_pos | BEGIN of raw_pos | END of raw_pos | PRINT of (string * raw_pos)
| NEW of (raw_pos) | FORMAT of (raw_pos) | AT of raw_pos | DOLLAR of raw_pos | PERCENT of raw_pos | AMPERSAND of raw_pos
| STAR of raw_pos | ARRAYLEN of raw_pos | SEMI_COLON of raw_pos | PKG_SCOPE of raw_pos | PAREN of raw_pos | PAREN_END of raw_pos | BRACKET of raw_pos
@@ -72,7 +72,7 @@ let rec raw_token_to_pos_and_token spaces = function
| BAREWORD(s, pos) -> pos, Parser.BAREWORD(s, (spaces, pos))
| BAREWORD_PAREN(s, pos) -> pos, Parser.BAREWORD_PAREN(s, (spaces, pos))
| REVISION(s, pos) -> pos, Parser.REVISION(s, (spaces, pos))
- | COMMENT(s, pos) -> pos, Parser.COMMENT(s, (spaces, pos))
+ | PERL_CHECKER_COMMENT(s, pos) -> pos, Parser.PERL_CHECKER_COMMENT(s, (spaces, pos))
| POD(s, pos) -> pos, Parser.POD(s, (spaces, pos))
| LABEL(s, pos) -> pos, Parser.LABEL(s, (spaces, pos))
| PRINT(s, pos) -> pos, Parser.PRINT(s, (spaces, pos))
@@ -102,6 +102,7 @@ let rec raw_token_to_pos_and_token spaces = function
| BIT_SHIFT(s, pos) -> pos, Parser.BIT_SHIFT(s, (spaces, pos))
| PLUS(s, pos) -> pos, Parser.PLUS(s, (spaces, pos))
| ONE_SCALAR_PARA(s, pos) -> pos, Parser.ONE_SCALAR_PARA(s, (spaces, pos))
+ | MY_OUR(s, pos) -> pos, Parser.MY_OUR(s, (spaces, pos))
| EOF (pos) -> pos, Parser.EOF ((), (spaces, pos))
| IF (pos) -> pos, Parser.IF ((), (spaces, pos))
@@ -111,7 +112,6 @@ let rec raw_token_to_pos_and_token spaces = function
| DO (pos) -> pos, Parser.DO ((), (spaces, pos))
| WHILE (pos) -> pos, Parser.WHILE ((), (spaces, pos))
| UNTIL (pos) -> pos, Parser.UNTIL ((), (spaces, pos))
- | MY (pos) -> pos, Parser.MY ((), (spaces, pos))
| CONTINUE (pos) -> pos, Parser.CONTINUE ((), (spaces, pos))
| SUB (pos) -> pos, Parser.SUB ((), (spaces, pos))
| LOCAL (pos) -> pos, Parser.LOCAL ((), (spaces, pos))
@@ -281,6 +281,10 @@ let ident_type_from_char fq name lexbuf c =
| '*' -> STAR_IDENT (fq, name, pos lexbuf)
| _ -> internal_error "ident_type_from_char"
+let split_at_two_colons s =
+ let i_fq = String.rindex s ':' in
+ String.sub s 0 (i_fq - 1), skip_n_char (i_fq + 1) s
+
let ident_from_lexbuf lexbuf =
let fq, name = split_at_two_colons (lexeme lexbuf) in
RAW_IDENT(Some fq, name, pos lexbuf)
@@ -325,6 +329,7 @@ rule token = parse
if lexeme_start lexbuf = !not_ok_for_match then not_ok_for_match := lexeme_end lexbuf;
SPACE(lexeme_end lexbuf - lexeme_start lexbuf)
}
+| "# perl_checker: " [^ '\n']* { PERL_CHECKER_COMMENT(skip_n_char 16 (lexeme lexbuf), pos lexbuf) }
| '#' [^ '\n']* { SPACE(1) }
| "\n=" {
@@ -395,7 +400,8 @@ rule token = parse
| "until" { UNTIL(pos lexbuf) }
| "foreach" { FOR(lexeme lexbuf, pos lexbuf) }
| "for" { FOR(lexeme lexbuf, pos lexbuf) }
-| "my" { MY(pos lexbuf) }
+| "my" { MY_OUR(lexeme lexbuf, pos lexbuf) }
+| "our" { MY_OUR(lexeme lexbuf, pos lexbuf) }
| "local" { LOCAL(pos lexbuf) }
| "continue" { CONTINUE(pos lexbuf) }
| "sub" { SUB(pos lexbuf) }
@@ -413,11 +419,11 @@ rule token = parse
| "print " ident ' ' {
putback lexbuf 1;
- PRINT_TO_STAR(skip_n_char_ 6 1 (lexeme lexbuf), pos lexbuf);
+ PRINT_TO_STAR(skip_n_char 6 (lexeme lexbuf), pos lexbuf);
}
| "print $" ident ' ' {
putback lexbuf 1;
- PRINT_TO_SCALAR(skip_n_char_ 7 1 (lexeme lexbuf), pos lexbuf);
+ PRINT_TO_SCALAR(skip_n_char 7 (lexeme lexbuf), pos lexbuf);
}
| ident ' '* "=>" { (* needed so that (if => 1) works *)
@@ -556,7 +562,7 @@ rule token = parse
| '$' [^ '{' ' ' '\n' '$']
| "$^" [^ '{' ' ' '\n'] { typed_ident_from_lexbuf lexbuf }
-| "$$" [^ 'a'-'z' 'A'-'Z' '_' '{'] { putback lexbuf 1; SCALAR_IDENT(None, "$$", pos lexbuf) }
+| "$$" [^ 'a'-'z' 'A'-'Z' '_' '{'] { putback lexbuf 1; SCALAR_IDENT(None, "$", pos lexbuf) }
| stash "::" { putback lexbuf 2; ident_type_from_char None "main" lexbuf (lexeme_char lexbuf 0) }
@@ -612,7 +618,7 @@ and string = parse
and delimited_string = parse
| '\\' { Stack.push delimited_string next_rule ; string_escape lexbuf }
| '$' { Stack.push delimited_string next_rule ; delimited_string_interpolate_scalar lexbuf }
-| '@' { Stack.push delimited_string next_rule ; string_interpolate_array lexbuf }
+| '@' { Stack.push delimited_string next_rule ; delimited_string_interpolate_array lexbuf }
| '\n' {
add_a_new_line(lexeme_end lexbuf);
next delimited_string lexbuf
@@ -738,15 +744,14 @@ and delimited_string_interpolate_scalar = parse (* needed for delimited string l
die lexbuf (Printf.sprintf "I really can't handle this, [xxx] can be indexing or not based on stellar position :-(")
}
-
| "{"
| ident "->"? '{'
| eof { next_s "$" (Stack.pop next_rule) lexbuf }
| _ {
let c = lexeme_char lexbuf 0 in
- if c <> !delimit_char && c <> '|' && c<>')' && c<>'/' then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf));
+ if c <> !delimit_char && c <> '|' && c<>')' && c<>'/' && c<>' ' then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf));
putback lexbuf 1;
- (Stack.pop next_rule) lexbuf
+ next_s "$" (Stack.pop next_rule) lexbuf
}
and string_interpolate_array = parse
@@ -754,10 +759,24 @@ and string_interpolate_array = parse
| '{' [^ '{' '}']* '}'
| (ident | (ident? ("::" ident)+)) { string_interpolate token "@" lexbuf }
-| [ '*' '<' '>' ']' '.' '('] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
+| [ '@' '*' '<' '>' ']' '.' '('] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
| eof { next_s "$" (Stack.pop next_rule) lexbuf }
| _ { warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("$" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
+and delimited_string_interpolate_array = parse
+| '$' ident
+| '{' [^ '{' '}']* '}'
+| (ident | (ident? ("::" ident)+)) { string_interpolate token "@" lexbuf }
+
+| [ '@' '*' '<' '>' ']' '.' '('] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
+| eof { next_s "$" (Stack.pop next_rule) lexbuf }
+| _ {
+ let c = lexeme_char lexbuf 0 in
+ if c <> !delimit_char then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf));
+ putback lexbuf 1;
+ next_s "$" (Stack.pop next_rule) lexbuf
+ }
+
and pattern_options = parse
| [ 'g' 'i' 'm' 'o' 's' 'x' 'e' 'd' ] { next pattern_options lexbuf }
| _ { putback lexbuf 1; () }
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index 05bdfe4..2114de6 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly
@@ -12,7 +12,7 @@
%token <unit * (Types.spaces * Types.raw_pos)> EOF
-%token <string * (Types.spaces * Types.raw_pos)> NUM RAW_STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PRINT_TO_STAR PRINT_TO_SCALAR ONE_SCALAR_PARA
+%token <string * (Types.spaces * Types.raw_pos)> NUM RAW_STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PERL_CHECKER_COMMENT PRINT_TO_STAR PRINT_TO_SCALAR ONE_SCALAR_PARA
%token <string * (Types.spaces * Types.raw_pos)> QUOTEWORDS COMPACT_HASH_SUBSCRIPT
%token <(string * Types.raw_pos) * (Types.spaces * Types.raw_pos)> RAW_HERE_DOC
%token <(string * ((int * int) * token) list) list * (Types.spaces * Types.raw_pos)> STRING COMMAND_STRING
@@ -27,9 +27,9 @@
%token <string * (Types.spaces * Types.raw_pos)> FOR PRINT
%token <unit * (Types.spaces * Types.raw_pos)> NEW FORMAT
%token <string * (Types.spaces * Types.raw_pos)> COMPARE_OP EQ_OP
-%token <string * (Types.spaces * Types.raw_pos)> ASSIGN
+%token <string * (Types.spaces * Types.raw_pos)> ASSIGN MY_OUR
-%token <unit * (Types.spaces * Types.raw_pos)> IF ELSIF ELSE UNLESS DO WHILE UNTIL MY CONTINUE SUB LOCAL
+%token <unit * (Types.spaces * Types.raw_pos)> IF ELSIF ELSE UNLESS DO WHILE UNTIL CONTINUE SUB LOCAL
%token <unit * (Types.spaces * Types.raw_pos)> USE PACKAGE BEGIN END
%token <unit * (Types.spaces * Types.raw_pos)> AT DOLLAR PERCENT AMPERSAND STAR ARRAYLEN
%token <unit * (Types.spaces * Types.raw_pos)> SEMI_COLON PKG_SCOPE
@@ -89,81 +89,85 @@
%left PAREN PREC_HIGH
%left ARRAYREF BRACKET
-%type <Types.fromparser list> prog inside
+%type <Types.fromparser list> prog
%type <(Types.priority * Types.fromparser) * (Types.spaces * Types.raw_pos)> expr term
-%start prog inside
+%start prog
%%
-prog: lines EOF {check_package (fst $1); fst $1}
-inside: lines EOF {fst $1}
+prog: lines EOF {fst $1}
lines: /* A collection of "lines" in the program */
| {[], (Space_none, bpos)}
| sideff {[fst $1], snd $1}
-| line lines {fst $1 @ fst $2, pos_range $1 $2}
+| line lines {fst $1 @ fst $2, sp_pos_range $1 $2}
line:
| decl {[fst $1], snd $1}
| if_then_else {[fst $1], snd $1}
| loop {[fst $1], snd $1}
| LABEL {sp_cr($1); [Label(fst $1)], snd $1}
+| PERL_CHECKER_COMMENT {sp_p($1); [Perl_checker_comment(fst $1, get_pos $1)], snd $1}
| semi_colon {[Semi_colon], snd $1}
| sideff semi_colon {[fst $1 ; Semi_colon], snd $1}
-| BRACKET lines BRACKET_END {check_block_sub $2 $3; [Block(fst $2)], pos_range $1 $3}
+| 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), 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), 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; 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}
elsif:
| {[], (Space_none, bpos)}
-| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); check_block_sub $6 $7; prio_lo P_loose $3 :: Block(fst $6) :: fst $8, pos_range $1 $8}
+| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); check_block_sub $6 $7; prio_lo P_loose $3 :: Block(fst $6) :: fst $8, sp_pos_range $1 $8}
else_:
| { [], (Space_none, bpos) }
-| ELSE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_sub $3 $4; [Block(fst $3)], pos_range $1 $4}
+| 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) ]), 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) ]), pos_range $1 $8}
-| FOR MY SCALAR_IDENT PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); check_foreach($1); sp_n($4); sp_0($5); sp_0_or_cr($6); sp_p($7); check_block_sub $8 $9; Call_op("foreach my", [ to_Ident $3; prio_lo P_loose $5; Block(fst $8) ]), pos_range $1 $10}
+| 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}
| 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) ]), 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) ]), pos_range $1 $11}
+| 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_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}
+
cont: /* Continue blocks */
| {(), (Space_none, bpos)}
-| CONTINUE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_sub $3 $4; (), pos_range $1 $4}
+| CONTINUE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_sub $3 $4; (), sp_pos_range $1 $4}
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 ]), 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 ]), 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 ]), 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 ]), 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 ]), 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); 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}
decl:
-| FORMAT BAREWORD ASSIGN {Too_complex, pos_range $1 $3}
-| FORMAT ASSIGN {Too_complex, pos_range $1 $2}
+| FORMAT BAREWORD ASSIGN {Too_complex, sp_pos_range $1 $3}
+| FORMAT ASSIGN {Too_complex, sp_pos_range $1 $2}
| func_decl semi_colon {die_rule (if sndfst $1 = "" then "there is no need to pre-declare in Perl!" else "please don't use prototype pre-declaration") }
-| func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = fst $1 in sub_declaration (name, proto) [], pos_range $1 $3}
-| func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_sub $3 $4; sub_declaration (fst $1) (fst $3), pos_range $1 $4}
-| func_decl BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sub_declaration (fst $1) [Ref(I_hash, prio_lo P_loose $4)], pos_range $1 $6}
-| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); sub_declaration (fst $1) [Ref(I_hash, prio_lo P_loose $4); Semi_colon], pos_range $1 $7}
-| PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); Package(fst $2), pos_range $1 $3}
-| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; Sub_declaration(Ident(None, "BEGIN", get_pos $1), "", fst $3), pos_range $1 $4}
-| END BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; Sub_declaration(Ident(None, "END", get_pos $1), "", fst $3), pos_range $1 $4}
+| func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = fst $1 in sub_declaration (name, proto) [], sp_pos_range $1 $3}
+| func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_sub $3 $4; sub_declaration (fst $1) (fst $3), sp_pos_range $1 $4}
+| func_decl BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sub_declaration (fst $1) [Ref(I_hash, prio_lo P_loose $4)], sp_pos_range $1 $6}
+| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); sub_declaration (fst $1) [Ref(I_hash, prio_lo P_loose $4); Semi_colon], sp_pos_range $1 $7}
+| PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); Package(fst $2), sp_pos_range $1 $3}
+| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; Sub_declaration(Ident(None, "BEGIN", get_pos $1), "", Block(fst $3)), sp_pos_range $1 $4}
+| END BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; Sub_declaration(Ident(None, "END", get_pos $1), "", Block(fst $3)), sp_pos_range $1 $4}
| use {$1}
use:
-| use_word listexpr semi_colon {sp_n($2); Use(fst $1, sndfst $2), pos_range $1 $3}
+| use_word listexpr semi_colon {sp_n($2); Use(fst $1, sndfst $2), sp_pos_range $1 $3}
use_word:
-| use_revision word comma {fst $2, pos_range $1 $3}
-| use_revision word {fst $2, pos_range $1 $2}
+| use_revision word comma {fst $2, sp_pos_range $1 $3}
+| use_revision word {fst $2, sp_pos_range $1 $2}
| use_revision {Ident(None, "", get_pos $1), snd $1}
use_revision:
@@ -172,7 +176,7 @@ use_revision:
| USE {$1}
func_decl:
-| SUB word {(fst $2, ""), pos_range $1 $2}
+| SUB word {(fst $2, ""), sp_pos_range $1 $2}
| FUNC_DECL_WITH_PROTO {(Ident(None, fstfst $1, get_pos $1), sndfst $1), snd $1}
listexpr: /* Basic list expressions */
@@ -180,125 +184,127 @@ 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 ])), 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 ])), pos_range $1 $3}
+| 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}
| argexpr %prec PREC_LOW {(fstfst $1, List(sndfst $1)), snd $1}
argexpr: /* Expressions are a list of terms joined by commas */
-| argexpr comma {(P_comma, sndfst $1), pos_range $1 $2}
-| argexpr comma term {if not_simple (sndfst $3) then sp_p($3); (P_comma, sndfst $1 @ [sndfst $3]), pos_range $1 $3}
-| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); (P_comma, sndfst $1 @ [ Ref(I_hash, sndfst $4) ]), pos_range $1 $5}
+| argexpr comma {(P_comma, sndfst $1), sp_pos_range $1 $2}
+| argexpr comma term {if not_simple (sndfst $3) then sp_p($3); (P_comma, sndfst $1 @ [sndfst $3]), sp_pos_range $1 $3}
+| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); (P_comma, sndfst $1 @ [ Ref(I_hash, sndfst $4) ]), sp_pos_range $1 $5}
| term %prec PREC_LOW {(fstfst $1, [sndfst $1]), snd $1}
/********************************************************************************/
term:
-| term ASSIGN term {let pri = P_assign in call_op(op_p pri (fst $2) $2, $3, [sndfst $1; prio_lo_after pri $3]), pos_range $1 $3}
-| term PLUS term {let pri = P_add in call_op(op pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), pos_range $1 $3}
-| term COMPARE_OP term {let pri = P_cmp in call_op(op_p pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), pos_range $1 $3}
-| term LT term {let pri = P_cmp in call_op(op_p pri "<" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), pos_range $1 $3}
-| term GT term {let pri = P_cmp in call_op(op_p pri ">" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), pos_range $1 $3}
-| 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]), 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]), 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]), 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]), 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]), 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]), 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]), 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]), 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]), 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]), 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]), 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)]), 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)]), 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)]), pos_range $1 $5}
-
-
-| term PATTERN_MATCH PATTERN {sp_n($2); sp_p($3); (P_expr, Call_op("m//", sndfst $1 :: from_PATTERN $3)), 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)), 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)), pos_range $1 $3}
-
-| term PATTERN_MATCH scalar { (P_expr, Too_complex), pos_range $1 $3}
-| term PATTERN_MATCH_NOT scalar { (P_expr, Too_complex), pos_range $1 $3}
-
-| term PATTERN_MATCH RAW_STRING {die_with_pos (sndsnd $3) "use a regexp, not a string"}
-| term PATTERN_MATCH_NOT RAW_STRING {die_with_pos (sndsnd $3) "use a regexp, not a string"}
-| term PATTERN_MATCH STRING {die_with_pos (sndsnd $3) "use a regexp, not a string"}
-| term PATTERN_MATCH_NOT STRING {die_with_pos (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])), pos_range $1 $5}
-| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; sndfst $6])), pos_range $1 $7}
-| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; sndfst $4; prio_lo_after P_ternary $7])), pos_range $1 $7}
-| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; sndfst $4; sndfst $8])), pos_range $1 $9}
+| 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 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}
+
+| term PATTERN_MATCH RAW_STRING {die_with_rawpos (sndsnd $3) "use a regexp, not a string"}
+| term PATTERN_MATCH_NOT RAW_STRING {die_with_rawpos (sndsnd $3) "use a regexp, not a string"}
+| term PATTERN_MATCH STRING {die_with_rawpos (sndsnd $3) "use a regexp, not a string"}
+| 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}
/* 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])), pos_range $1 $2}
-| TIGHT_NOT term {(P_tight, Call_op("not", [sndfst $2])), pos_range $1 $2}
-| BIT_NEG term {(P_expr, Call_op("~", [sndfst $2])), pos_range $1 $2}
-| INCR term {sp_0($2); (P_tight, Call_op("++", [sndfst $2])), pos_range $1 $2}
-| DECR term {sp_0($2); (P_tight, Call_op("--", [sndfst $2])), pos_range $1 $2}
-| term INCR {sp_0($2); (P_tight, Call_op("++ post", [sndfst $1])), pos_range $1 $2}
-| term DECR {sp_0($2); (P_tight, Call_op("-- post", [sndfst $1])), pos_range $1 $2}
-| NOT argexpr {(P_and, Call_op("not", sndfst $2)), pos_range $1 $2}
-
-| ONE_SCALAR_PARA RAW_STRING {call_one_scalar_para $1 [to_Raw_string $2], pos_range $1 $2}
-| ONE_SCALAR_PARA STRING {call_one_scalar_para $1 [to_String $2], pos_range $1 $2}
-| ONE_SCALAR_PARA variable {call_one_scalar_para $1 [fst $2], pos_range $1 $2}
-| ONE_SCALAR_PARA restricted_subscripted {call_one_scalar_para $1 [fst $2], pos_range $1 $2}
-| ONE_SCALAR_PARA parenthesized {call_one_scalar_para $1 (sndfst $2), pos_range $1 $2}
-| ONE_SCALAR_PARA word_paren parenthesized {call_one_scalar_para $1 [Call(fst $2, sndfst $3)], pos_range $1 $3}
+| 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}
+
+| 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 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(fst $2, sndfst $3)], sp_pos_range $1 $3}
/* Constructors for anonymous data */
-| ARRAYREF ARRAYREF_END {sp_0($2); (P_expr, Ref(I_array, List[])), pos_range $1 $2}
-| arrayref_start ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1))), pos_range $1 $2}
-| arrayref_start expr ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1 @ [sndfst $2]))), pos_range $1 $3}
-| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1 @ [Ref(I_hash, sndfst $3)]))), pos_range $1 $5}
+| ARRAYREF ARRAYREF_END {sp_0($2); (P_expr, Ref(I_array, List[])), sp_pos_range $1 $2}
+| arrayref_start ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1))), sp_pos_range $1 $2}
+| arrayref_start expr ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1 @ [sndfst $2]))), sp_pos_range $1 $3}
+| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1 @ [Ref(I_hash, sndfst $3)]))), sp_pos_range $1 $5}
-| BRACKET BRACKET_END {(P_expr, Ref(I_hash, List [])), pos_range $1 $2} /* empty hash */
-| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); (P_expr, Ref(I_hash, sndfst $2)), pos_range $1 $3} /* { foo => "Bar" } */
-| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); (P_expr, Anonymous_sub []), pos_range $1 $3}
-| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; (P_expr, Anonymous_sub(fst $3)), pos_range $1 $4}
+| BRACKET BRACKET_END {(P_expr, Ref(I_hash, List [])), sp_pos_range $1 $2} /* empty hash */
+| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); (P_expr, Ref(I_hash, sndfst $2)), sp_pos_range $1 $3} /* { foo => "Bar" } */
+| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); (P_expr, anonymous_sub []), sp_pos_range $1 $3}
+| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; (P_expr, anonymous_sub(fst $3)), sp_pos_range $1 $4}
| termdo {(P_tok, fst $1), snd $1}
-| REF term {(P_expr, Ref(I_scalar, sndfst $2)), pos_range $1 $2} /* \$x, \@y, \%z */
-| my %prec UNIOP {(P_expr, List(fst $1)), snd $1}
-| LOCAL term %prec UNIOP {sp_n($2); (P_expr, Local(sndfst $2)), pos_range $1 $2}
+| REF term {(P_expr, Ref(I_scalar, sndfst $2)), sp_pos_range $1 $2} /* \$x, \@y, \%z */
+| my_our %prec UNIOP {(P_expr, fst $1), snd $1}
+| 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))), pos_range $1 $2} /* list slice */
+| parenthesized arrayref {sp_0($2); (P_tok, Deref_with(I_array, List(sndfst $1), List(fst $2))), sp_pos_range $1 $2} /* list slice */
| variable {(P_tok, fst $1), snd $1}
| subscripted {(P_tok, fst $1), snd $1}
-| array arrayref {(P_expr, Deref_with(I_array, fst $1, List(fst $2))), 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, array_ident_to_hash_ident $1, sndfst $3)), pos_range $1 $4} /* hash slice: @hash{@keys} */
+| 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} */
/* function_calls */
-| func parenthesized {sp_0($2); (P_tok, call(fst $1, sndfst $2)), pos_range $1 $2} /* &foo(@args) */
-| word argexpr {check_parenthesized_first_argexpr (string_of_Ident (fst $1)) $2; (P_call_no_paren, call(fst $1, sndfst $2)), pos_range $1 $2} /* foo $a, $b */
-| word_paren parenthesized {(P_tok, call(fst $1, sndfst $2)), 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(fst $1, Anonymous_sub(fst $3) :: sndfst $5)), 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(fst $1, Anonymous_sub [ Ref(I_hash, sndfst $4) ] :: sndfst $7)), 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(fst $1, Anonymous_sub [ Ref(I_hash, sndfst $4); Semi_colon ] :: sndfst $8)), pos_range $1 $8} /* map { { foo }; } @bar */
+| func parenthesized {sp_0($2); (P_tok, call(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 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, Method_callP(sndfst $1, fst $3, sndfst $4)), pos_range $1 $4} /* $foo->bar(list) */
-| term ARROW word_or_scalar {sp_0($2); sp_0($3); (P_tok, Method_callP(sndfst $1, fst $3, [])), pos_range $1 $3} /* $foo->bar */
+| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); (P_tok, 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, 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, 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, Method_callP(sndfst $1, Ident(None, "x", get_pos $3), [])), sp_pos_range $1 $3} /* $foo->bar */
-| NEW word listexpr { (P_call_no_paren, Method_call(fst $2, Ident(None, "new", get_pos $1), sndfst $3)), pos_range $1 $3} /* new Class @args */
+| NEW word listexpr { (P_call_no_paren, Method_call(fst $2, Ident(None, "new", get_pos $1), sndfst $3)), sp_pos_range $1 $3} /* new Class @args */
| PRINT { (P_call_no_paren, Call_op("print", var_STDOUT :: [ var_dollar_ ])), snd $1}
-| PRINT argexpr {check_parenthesized_first_argexpr (fst $1) $2; (P_call_no_paren, Call_op("print", var_STDOUT :: sndfst $2)), pos_range $1 $2}
-| PRINT_TO_STAR { (P_call_no_paren, Call_op("print", Deref(I_star, Ident(None, fst $1, get_pos $1)) :: [ var_dollar_ ])), snd $1}
-| PRINT_TO_STAR argexpr { (P_call_no_paren, Call_op("print", Deref(I_star, Ident(None, fst $1, get_pos $1)) :: sndfst $2)), pos_range $1 $2}
-| PRINT_TO_SCALAR { (P_call_no_paren, Call_op("print", var_STDOUT :: [ Deref(I_scalar, Ident(None, fst $1, get_pos $1)) ])), snd $1}
-| PRINT_TO_SCALAR argexpr { (P_call_no_paren, Call_op("print", Deref(I_scalar, Ident(None, fst $1, get_pos $1)) :: sndfst $2)), pos_range $1 $2}
+| PRINT argexpr {check_parenthesized_first_argexpr (fst $1) $2; (P_call_no_paren, Call_op("print", var_STDOUT :: sndfst $2)), sp_pos_range $1 $2}
+| PRINT_TO_SCALAR { (P_call_no_paren, Call_op("print", var_STDOUT :: [ Deref(I_scalar, Ident(None, fst $1, get_pos $1)) ])), snd $1}
+| PRINT_TO_SCALAR argexpr { (P_call_no_paren, Call_op("print", Deref(I_scalar, Ident(None, fst $1, get_pos $1)) :: sndfst $2)), sp_pos_range $1 $2}
+| PRINT_TO_STAR { (P_call_no_paren, Call_op("print", Deref(I_star, Ident(None, fst $1, get_pos $1)) :: [ var_dollar_ ])), snd $1}
+| PRINT_TO_STAR argexpr { (P_call_no_paren, Call_op("print", Deref(I_star, Ident(None, fst $1, get_pos $1)) :: sndfst $2)), sp_pos_range $1 $2}
-| hash PKG_SCOPE {sp_0($2); (P_tok, Too_complex), pos_range $1 $2} /* %main:: */
+| hash PKG_SCOPE {sp_0($2); (P_tok, Too_complex), sp_pos_range $1 $2} /* %main:: */
| word {(P_tok, check_word_alone $1), snd $1}
@@ -315,55 +321,66 @@ term:
| diamond {(P_expr, fst $1), snd $1}
diamond:
-| LT GT {sp_0($2); Call_op("<>", []), pos_range $1 $2}
-| LT term GT {sp_0($2); sp_0($3); Call_op("<>", [sndfst $2]), pos_range $1 $3}
+| 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}
subscripted: /* Some kind of subscripted expression */
-| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); Too_complex, pos_range $1 $3} /* $foo::{something} */
-| scalar bracket_subscript {sp_0($2); Deref_with(I_hash , fst $1, fst $2), pos_range $1 $2} /* $foo{bar} */
-| scalar arrayref {sp_0($2); Deref_with(I_array, fst $1, only_one $2), pos_range $1 $2} /* $array[$element] */
-| term ARROW bracket_subscript {sp_0($2); sp_0($3); Deref_with(I_hash , sndfst $1, fst $3), pos_range $1 $3} /* somehref->{bar} */
-| term ARROW arrayref {sp_0($2); sp_0($3); Deref_with(I_array, sndfst $1, only_one $3), pos_range $1 $3} /* somearef->[$element] */
-| term ARROW parenthesized {sp_0($2); sp_0($3); Deref_with(I_func , sndfst $1, List(sndfst $3)), pos_range $1 $3} /* $subref->(@args) */
-| subscripted bracket_subscript {sp_0($2); Deref_with(I_hash , fst $1, fst $2), pos_range $1 $2} /* $foo->[bar]{baz} */
-| subscripted arrayref {sp_0($2); Deref_with(I_array, fst $1, only_one $2), pos_range $1 $2} /* $foo->[$bar][$baz] */
-| subscripted parenthesized {sp_0($2); Deref_with(I_func , fst $1, List(sndfst $2)), 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); 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) */
restricted_subscripted: /* Some kind of subscripted expression */
-| scalar bracket_subscript {sp_0($2); Deref_with(I_hash , fst $1, fst $2), pos_range $1 $2} /* $foo{bar} */
-| scalar arrayref {sp_0($2); Deref_with(I_array, fst $1, only_one $2), pos_range $1 $2} /* $array[$element] */
-| restricted_subscripted bracket_subscript {sp_0($2); Deref_with(I_hash , fst $1, fst $2), pos_range $1 $2} /* $foo->[bar]{baz} */
-| restricted_subscripted arrayref {sp_0($2); Deref_with(I_array, fst $1, only_one $2), pos_range $1 $2} /* $foo->[$bar][$baz] */
-| restricted_subscripted parenthesized {sp_0($2); Deref_with(I_func , fst $1, List(sndfst $2)), pos_range $1 $2} /* $foo->{bar}(@args) */
+| 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) */
arrayref:
-| arrayref_start ARRAYREF_END {sp_0($2); fst $1, pos_range $1 $2}
-| arrayref_start expr ARRAYREF_END {sp_0($3); fst $1 @ [sndfst $2], pos_range $1 $3}
-| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_p($2); sp_p($4); sp_0($5); fst $1 @ [Ref(I_hash, sndfst $3)], pos_range $1 $5}
+| arrayref_start ARRAYREF_END {sp_0($2); fst $1, sp_pos_range $1 $2}
+| arrayref_start expr ARRAYREF_END {sp_0($3); fst $1 @ [sndfst $2], sp_pos_range $1 $3}
+| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_p($2); sp_p($4); sp_0($5); fst $1 @ [Ref(I_hash, sndfst $3)], sp_pos_range $1 $5}
parenthesized:
-| parenthesized_start PAREN_END {sp_0_or_cr($2); ((if fst $1 = [] then P_tok else P_paren P_comma), fst $1), pos_range $1 $2}
-| parenthesized_start expr PAREN_END {sp_0_or_cr($3); (P_paren(if fst $1 = [] then fstfst $2 else P_comma), fst $1 @ [(if fst $1 = [] then prio_lo P_loose else prio_lo_after P_comma) $2]), pos_range $1 $3}
-| parenthesized_start BRACKET expr BRACKET_END PAREN_END {sp_p($4); sp_0_or_cr($5); (P_paren(if fst $1 = [] then P_expr else P_comma), fst $1 @ [Ref(I_hash, sndfst $3)]), pos_range $1 $5}
+| parenthesized_start PAREN_END {sp_0_or_cr($2); ((if fst $1 = [] then P_tok else P_paren P_comma), fst $1), sp_pos_range $1 $2}
+| parenthesized_start expr PAREN_END {sp_0_or_cr($3); (P_paren(if fst $1 = [] then fstfst $2 else P_comma), fst $1 @ [(if fst $1 = [] then prio_lo P_loose else prio_lo_after P_comma) $2]), sp_pos_range $1 $3}
+| parenthesized_start BRACKET expr BRACKET_END PAREN_END {sp_p($4); sp_0_or_cr($5); (P_paren(if fst $1 = [] then P_expr else P_comma), fst $1 @ [Ref(I_hash, sndfst $3)]), sp_pos_range $1 $5}
arrayref_start:
| ARRAYREF {[], snd $1}
-| arrayref_start BRACKET expr BRACKET_END comma {sp_p($2); sp_p($3); sp_p($4); fst $1 @ [Ref(I_hash, sndfst $3)], pos_range $1 $5}
+| arrayref_start BRACKET expr BRACKET_END comma {sp_p($2); sp_p($3); sp_p($4); fst $1 @ [Ref(I_hash, sndfst $3)], sp_pos_range $1 $5}
parenthesized_start:
| PAREN {[], snd $1}
-| parenthesized_start BRACKET expr BRACKET_END comma {(if fst $1 = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); fst $1 @ [Ref(I_hash, sndfst $3)], pos_range $1 $5}
-
-my: /* Things that can be "my"'d */
-| MY parenthesized {List.map (fun e -> My e) (sndfst $2), pos_range $1 $2}
-| MY scalar {[My(fst $2)], pos_range $1 $2}
-| MY hash {[My(fst $2)], pos_range $1 $2}
-| MY array {[My(fst $2)], pos_range $1 $2}
+| parenthesized_start BRACKET expr BRACKET_END comma {(if fst $1 = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); fst $1 @ [Ref(I_hash, sndfst $3)], sp_pos_range $1 $5}
+
+my_our: /* Things that can be "my"'d */
+| my_our_paren PAREN_END {sp_0($2); if sndfst $1 <> [] && fst (fstfst $1) then die_rule "syntax error"; My_our(snd (fstfst $1), sndfst $1, get_pos $1), sp_pos_range $1 $2}
+| my_our_paren SCALAR_IDENT PAREN_END {(if sndfst $1 = [] then sp_0 else sp_1)($2); check_my_our_paren $1; My_our(snd (fstfst $1), sndfst $1 @ [I_scalar, sndfst $2], pos_range $1 $3), sp_pos_range $1 $3}
+| my_our_paren HASH_IDENT PAREN_END {(if sndfst $1 = [] then sp_0 else sp_1)($2); check_my_our_paren $1; My_our(snd (fstfst $1), sndfst $1 @ [I_hash, sndfst $2], pos_range $1 $3), sp_pos_range $1 $3}
+| my_our_paren ARRAY_IDENT PAREN_END {(if sndfst $1 = [] then sp_0 else sp_1)($2); check_my_our_paren $1; My_our(snd (fstfst $1), sndfst $1 @ [I_array, sndfst $2], pos_range $1 $3), sp_pos_range $1 $3}
+| MY_OUR SCALAR_IDENT {My_our(fst $1, [I_scalar, sndfst $2], get_pos $2), sp_pos_range $1 $2}
+| MY_OUR HASH_IDENT {My_our(fst $1, [I_hash, sndfst $2], get_pos $2), sp_pos_range $1 $2}
+| MY_OUR ARRAY_IDENT {My_our(fst $1, [I_array, sndfst $2], get_pos $2), sp_pos_range $1 $2}
+
+my_our_paren:
+| MY_OUR PAREN {sp_1($2); ((true, fst $1), []), sp_pos_range $1 $2}
+| my_our_paren comma {if fst (fstfst $1) then die_rule "syntax error"; ((true, snd (fstfst $1)), sndfst $1), sp_pos_range $1 $2}
+| my_our_paren BAREWORD {check_my_our_paren $1; if fst $2 <> "undef" then die_rule "scalar expected"; ((false, snd (fstfst $1)), sndfst $1 @ [I_raw, fst $2]), sp_pos_range $1 $2}
+| my_our_paren SCALAR_IDENT {check_my_our_paren $1; ((false, snd (fstfst $1)), sndfst $1 @ [I_scalar, sndfst $2]), sp_pos_range $1 $2}
+| my_our_paren HASH_IDENT {check_my_our_paren $1; ((false, snd (fstfst $1)), sndfst $1 @ [I_hash, sndfst $2]), sp_pos_range $1 $2}
+| my_our_paren ARRAY_IDENT {check_my_our_paren $1; ((false, snd (fstfst $1)), sndfst $1 @ [I_array, sndfst $2]), sp_pos_range $1 $2}
termdo: /* Things called with "do" */
| DO term %prec UNIOP { die_rule "\"do EXPR\" not allowed" } /* do $filename */
-| DO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; Block(fst $3), pos_range $1 $4} /* do { code */
+| 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, pos_range $1 $3}
+| BRACKET expr BRACKET_END {sp_0($1); sp_same $2 $3; only_one_in_List $2, sp_pos_range $1 $3}
| COMPACT_HASH_SUBSCRIPT {sp_0($1); to_Raw_string $1, snd $1}
variable:
@@ -396,17 +413,17 @@ word_paren:
| BAREWORD_PAREN { Ident(None, fst $1, get_pos $1), snd $1}
| RAW_IDENT_PAREN { to_Ident $1, snd $1}
-arraylen: ARRAYLEN_IDENT {Deref(I_arraylen, to_Ident $1), snd $1} | ARRAYLEN scalar {sp_0($2); Deref(I_arraylen, fst $2), snd $1} | ARRAYLEN bracket_subscript {Deref(I_arraylen, fst $2), pos_range $1 $2}
-scalar: SCALAR_IDENT {Deref(I_scalar , to_Ident $1), snd $1} | DOLLAR scalar {sp_0($2); Deref(I_scalar , fst $2), snd $1} | DOLLAR bracket_subscript {Deref(I_scalar , fst $2), pos_range $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); Deref(I_scalar, Ref(I_hash, sndfst $4)), pos_range $1 $6}
-func: FUNC_IDENT {Deref(I_func , to_Ident $1), snd $1} | AMPERSAND scalar {sp_0($2); Deref(I_func , fst $2), snd $1} | AMPERSAND bracket_subscript {Deref(I_func , fst $2), pos_range $1 $2}
-array: ARRAY_IDENT {Deref(I_array , to_Ident $1), snd $1} | AT scalar {sp_0($2); Deref(I_array , fst $2), snd $1} | AT bracket_subscript {Deref(I_array , fst $2), pos_range $1 $2}
-hash: HASH_IDENT {Deref(I_hash , to_Ident $1), snd $1} | PERCENT scalar {sp_0($2); Deref(I_hash , fst $2), snd $1} | PERCENT bracket_subscript {Deref(I_hash , fst $2), pos_range $1 $2}
-star: STAR_IDENT {Deref(I_star , to_Ident $1), snd $1} | STAR scalar {sp_0($2); Deref(I_star , fst $2), snd $1} | STAR bracket_subscript {Deref(I_star , fst $2), pos_range $1 $2}
+arraylen: ARRAYLEN_IDENT {deref_arraylen (to_Ident $1), snd $1} | ARRAYLEN scalar {sp_0($2); deref_arraylen (fst $2), snd $1} | ARRAYLEN bracket_subscript {deref_arraylen (fst $2), sp_pos_range $1 $2}
+scalar: SCALAR_IDENT {Deref(I_scalar, to_Ident $1), snd $1} | DOLLAR scalar {sp_0($2); Deref(I_scalar, fst $2), snd $1} | DOLLAR bracket_subscript {Deref(I_scalar, fst $2), sp_pos_range $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); Deref(I_scalar, Ref(I_hash, sndfst $4)), sp_pos_range $1 $6}
+func: FUNC_IDENT {Deref(I_func , to_Ident $1), snd $1} | AMPERSAND scalar {sp_0($2); Deref(I_func , fst $2), snd $1} | AMPERSAND bracket_subscript {Deref(I_func , fst $2), sp_pos_range $1 $2}
+array: ARRAY_IDENT {Deref(I_array , to_Ident $1), snd $1} | AT scalar {sp_0($2); Deref(I_array , fst $2), snd $1} | AT bracket_subscript {Deref(I_array , fst $2), sp_pos_range $1 $2}
+hash: HASH_IDENT {Deref(I_hash , to_Ident $1), snd $1} | PERCENT scalar {sp_0($2); Deref(I_hash , fst $2), snd $1} | PERCENT bracket_subscript {Deref(I_hash , fst $2), sp_pos_range $1 $2}
+star: STAR_IDENT {Deref(I_star , to_Ident $1), snd $1} | STAR scalar {sp_0($2); Deref(I_star , fst $2), snd $1} | STAR bracket_subscript {Deref(I_star , fst $2), sp_pos_range $1 $2}
expr_or_empty: {Block [], (Space_none, bpos)} | expr {sndfst $1, snd $1}
%%
;;
-prog_ref := Some inside
+prog_ref := Some prog
;;
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
diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli
index 4655810..66395c1 100644
--- a/perl_checker.src/parser_helper.mli
+++ b/perl_checker.src/parser_helper.mli
@@ -1,6 +1,8 @@
val bpos : int * int
val raw_pos2pos : 'a * 'b -> string * 'a * 'b
val pos_range :
+ 'a * ('b * (int * int)) -> 'c * ('d * (int * int)) -> string * int * int
+val sp_pos_range :
'a * ('b * (int * int)) -> 'c * ('d * (int * int)) -> 'b * (int * int)
val get_pos : 'a * ('b * ('c * 'd)) -> string * 'c * 'd
val var_dollar_ : Types.fromparser
@@ -11,8 +13,10 @@ 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 msg_with_pos : int * int -> string -> string
-val die_with_pos : int * int -> string -> 'a
+val from_scalar : Types.fromparser * 'a -> Types.fromparser
+val from_array : Types.fromparser * 'a -> Types.fromparser
+val msg_with_rawpos : int * int -> string -> string
+val die_with_rawpos : int * int -> string -> 'a
val warn : int * int -> string -> unit
val die_rule : string -> 'a
val warn_rule : string -> unit
@@ -48,17 +52,27 @@ val check_parenthesized_first_argexpr :
('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_package : Types.fromparser list -> unit
-val check_my : string -> Types.fromparser list -> 'a * (int * int) -> unit
+val check_MULT_is_x : string * 'a -> unit
+val check_my : string * 'a -> unit
+val check_my_our :
+ string -> Types.fromparser list -> 'a * (int * int) -> unit
val check_block_sub :
Types.fromparser list * (Types.spaces * (int * int)) ->
'a * (Types.spaces * (int * 'b)) -> unit
val check_block_ref :
Types.fromparser list * (Types.spaces * (int * int)) ->
'a * (Types.spaces * (int * 'b)) -> unit
+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 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_Local :
+ ('a * Types.fromparser) * ('b * (int * int)) -> Types.fromparser
val op : 'a -> 'b -> 'c * 'd -> 'a * ((unit * 'd) * 'b)
val op_p :
'a ->
@@ -69,14 +83,9 @@ val call_op :
('a * (('b * (Types.spaces * (int * 'c))) * string)) *
('d * (Types.spaces * (int * int))) * Types.fromparser list ->
'a * Types.fromparser
-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 array_ident_to_hash_ident :
- Types.fromparser * ('a * (int * int)) -> Types.fromparser
-val to_List : Types.fromparser list -> Types.fromparser
val sub_declaration :
Types.fromparser * string -> Types.fromparser list -> Types.fromparser
+val anonymous_sub : Types.fromparser list -> Types.fromparser
val call : Types.fromparser * Types.fromparser list -> Types.fromparser
val call_one_scalar_para :
string * ('a * (int * int)) ->
diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml
index 7e951a8..78dc2d5 100644
--- a/perl_checker.src/perl_checker.ml
+++ b/perl_checker.src/perl_checker.ml
@@ -1,19 +1,72 @@
open Types
+open Common
+open Tree
-let _ =
- let args = List.tl (Array.to_list Sys.argv) in
- let args = if args = [] then ["/tmp/t.pl"] else args in
- List.iter (fun file ->
- try
- let lexbuf = Lexing.from_channel (Unix.open_process_in (Printf.sprintf "expand \"%s\"" file)) in
+let inc =
+ let inc_ref = ref [] in
+ let ignored_packages = ref [] in
+ let rec updir dir nb =
+ if nb = 0 then dir else
+ match dir with
+ | "." -> String.concat "/" (times ".." nb)
+ | _ -> updir (Filename.dirname dir) (nb-1)
+ in
+ fun file_name package_name has_package_name ->
+ if !inc_ref = [] then (
+ let reldir = if has_package_name then updir file_name (List.length(split_at2 ':'':' package_name)) else "." in
+ let default = readlines (Unix.open_process_in "perl -le 'print foreach @INC'") in
+ inc_ref := reldir :: default ;
+
try
- Info.start_a_new_file file ;
- let tokens = Lexer.get_token Lexer.token lexbuf in
- let t = Parser_helper.parse_tokens Parser.prog tokens (Some lexbuf) in
- let _,_ = t, t in ()
- with Failure s -> (
- prerr_endline s ;
- exit 1
+ ignored_packages := readlines (open_in (reldir ^ "/.perl_checker"))
+ with Sys_error _ -> ()
+ );
+ !inc_ref, !ignored_packages
+
+let findfile dirs f = List.find Sys.file_exists (List.map (fun dir -> dir ^ "/" ^ f) dirs)
+
+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
+ try
+ Info.start_a_new_file file ;
+ let tokens = Lexer.get_token Lexer.token lexbuf in
+ let t = Parser_helper.parse_tokens Parser.prog tokens (Some lexbuf) in
+ let package = get_global_info_from_package t in
+ Tree.get_global_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 package.uses in
+ state
+ with Failure s -> (
+ prerr_endline s ;
+ exit 1
)
- with _ -> prerr_endline ("bad file " ^ file)
- ) args
+ with _ -> failwith ("bad file " ^ file)
+
+and parse_package_if_needed state (package_name, (_, pos)) =
+ if List.mem_assoc package_name state.per_package then state else
+ try
+ let package = snd (List.hd state.per_package) in
+ let inc, ignored_packages = inc package.file_name package.package_name package.has_package_name in
+ 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)
+ with Not_found ->
+ Tree.warn_with_pos pos (Printf.sprintf "can't find package %s" package_name) ;
+ state
+
+
+let parse_options =
+ let args_r = ref [] in
+ let options = [
+ "-v", Arg.Set Flags.verbose, " be verbose" ;
+ "-q", Arg.Set Flags.quiet, " be quiet" ;
+ ] in
+ let usage = "Usage: perl_checker [-v] [-q] <files>\nOptions are:" in
+ Arg.parse options (lpush args_r) usage;
+
+ let args = if !args_r = [] then ["../t.pl"] else !args_r in
+ let state = List.fold_left parse_file default_state args 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
new file mode 100644
index 0000000..7353629
--- /dev/null
+++ b/perl_checker.src/tree.ml
@@ -0,0 +1,424 @@
+open Types
+open Common
+open Printf
+
+type exports = {
+ export_ok : (context * string) list ;
+ export_auto : (context * string) list ;
+ export_tags : (string * (context * string) list) list ;
+ re_export_all : bool ;
+ }
+
+type uses = (string * ((context * string) list option * pos)) list
+
+type per_package = {
+ file_name : string ;
+ package_name : string ; has_package_name : bool ;
+ exports : exports ;
+ uses : uses ;
+ body : fromparser list;
+ }
+type state = {
+ per_package : (string * per_package) list ;
+ global_vars_declared : (context * string * string, pos) Hashtbl.t ;
+ global_vars_used : ((context * string * string) * pos) list ref ;
+ }
+
+type vars = {
+ my_vars : (context * string) list list ;
+ our_vars : (context * string) list list ;
+ imported : ((context * string) * string) list ;
+ current_package : string ;
+ 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 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
+ | '%' -> I_hash , skip_n_char 1 s
+ | '@' -> I_array , skip_n_char 1 s
+ | '&' -> I_func , skip_n_char 1 s
+ | '*' -> I_star , skip_n_char 1 s
+ | _ -> I_raw, s
+
+
+
+let get_current_package t =
+ match t with
+ | Package(Ident _ as ident) :: _ ->
+ Some (Parser_helper.string_of_Ident ident)
+ | _ ->
+ 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
+
+let from_qw = function
+ | Call_op("qw", [ Raw_string(s, pos)]) ->
+ List.map (fun s ->
+ let context, s' = s2context s in
+ let context =
+ match context with
+ | I_raw -> if s'.[0] = ':' then I_raw else I_func
+ | I_func -> warn_with_pos pos "weird, exported name with a function context especially given"; I_func
+ | _ -> context
+ in context, s'
+ ) (words s)
+ | String(_, pos) ->
+ warn_with_pos pos "not recognised yet" ;
+ []
+ | _ -> internal_error "get_exported"
+
+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" ;
+ exports
+
+ | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", pos)); v ])]
+ | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], pos); v ])] ->
+ 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 }
+
+ | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT_OK", pos)); v ])]
+ | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT_OK")], pos); v ])] ->
+ if exports.export_ok <> [] then warn_with_pos pos "weird, @EXPORT_OK set twice" ;
+ (match v with
+ | Call(Deref(I_func, Ident(None, "map", _)),
+ [ Anonymous_sub(Block [List [Deref(I_array, Deref(I_scalar, Ident (None, "_", _)))]]);
+ Call(Deref(I_func, Ident(None, "values", _)), [ Deref(I_hash, Ident(None, "EXPORT_TAGS", _))])]) ->
+ { 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 ])] ->
+ (try
+ let export_tags =
+ match v with
+ | List [ List l ] ->
+ List.map (function
+ | Ident(None, tag, _), Ref(I_array, List [List [v]]) ->
+ let para =
+ match v with
+ | Deref(I_array, Ident(None, "EXPORT_OK", _)) -> exports.export_ok
+ | _ -> from_qw v
+ in
+ ":" ^ tag, para
+ | _ -> raise Not_found
+ ) (group_by_2 l)
+ | _ -> raise Not_found
+ in
+ if exports.export_tags <> [] then warn_with_pos pos "weird, %EXPORT_TAGS set twice" ;
+ { exports with export_tags = export_tags }
+ with _ ->
+ warn_with_pos pos "unrecognised @EXPORT_TAGS" ;
+ exports)
+ | List (My_our _ :: _) ->
+ let _,_ = e,e in
+ exports
+ | _ -> exports
+ ) empty_exports t
+
+let uses_external_package = function
+ | "vars" | "Exporter" | "diagnostics" | "strict" | "lib" | "POSIX" | "Config" | "Socket" | "Net::FTP" | "IO::Socket" | "DynaLoader" -> true
+ | _ -> false
+
+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(_, _, pos) as ident, l) ->
+ let package = Parser_helper.string_of_Ident ident in
+ let para = if l = [] then None else Some(from_qw (List.hd l)) in
+ (package, (para, pos)) :: uses
+ | _ -> uses
+ ) [] t
+
+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 { file_name = !Info.current_file ; package_name = package_name; has_package_name = current_package <> None ; exports = exports ; uses = uses ; body = t }
+
+let get_global_vars_declaration state package =
+ List.iter (function
+ | Sub_declaration(Ident(fq, name, pos), _proto, _) ->
+ Hashtbl.add state.global_vars_declared (I_func, some_or fq package.package_name, name) pos
+
+ | List [ Call_op("=", [My_our("our", ours, pos); _]) ]
+ | My_our("our", ours, pos) ->
+ List.iter (fun (context, name) -> Hashtbl.add state.global_vars_declared (context, package.package_name, name) pos) ours
+ | Use(Ident(None, "vars", pos), [ours]) ->
+ List.iter (fun (context, name) -> Hashtbl.add state.global_vars_declared (context, package.package_name, name) pos) (from_qw ours)
+ | Use(Ident(None, "vars", pos), _) ->
+ die_with_pos pos "usage: \"use vars qw($var func)\""
+ | _ -> ()
+ ) 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
+ let imports_vars =
+ match imports with
+ | None ->
+ if exports.re_export_all then
+ collect (fun (package_name, _) -> (List.assoc package_name state.per_package).exports.export_ok) package_used.uses
+ else exports.export_auto
+ | Some l ->
+ 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.package_name) imports_vars
+ with Not_found -> []
+ in
+ collect get_one package.uses
+
+let rec fold_tree f env e =
+ match f env e with
+ | Some env -> env
+ | None ->
+ match e with
+ | Anonymous_sub(e')
+ | Ref(_, e')
+ | Deref(_, e')
+ | Package(e')
+ -> fold_tree f env e'
+
+ | Diamond(e')
+ -> fold_tree_option f env e'
+
+ | Sub_declaration(e1, _, e2)
+ | Deref_with(_, e1, e2)
+ | Binop(_, e1, e2)
+ ->
+ let env = fold_tree f env e1 in
+ let env = fold_tree f env e2 in
+ env
+
+ | List l
+ | Block l
+ | Call_op(_, l)
+ -> List.fold_left (fold_tree f) env l
+
+ | Call(e', l)
+ | CallP(e', l)
+ | Use(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
+ | None -> env
+ | Some e -> fold_tree f env e
+
+
+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_global_var_declared vars (context, fq, name) =
+ let fq = some_or fq vars.current_package in
+ Hashtbl.mem vars.state.global_vars_declared (context, fq, name)
+
+let is_global_var context ident =
+ match context with
+ | I_scalar ->
+ (match ident with
+ | "_" | "@" | "!" | ">" | "\\" | "$" | "^A" | "'" | "/" | "?" | "<" | "^W" | "|" | "^I"
+ | "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" -> true
+ | _ -> false)
+ | I_array ->
+ (match ident with
+ | "_" | "ARGV" -> true
+ | _ -> false)
+ | I_hash ->
+ (match ident with
+ | "ENV" | "SIG" -> true
+ | _ -> false)
+ | I_star ->
+ (match ident with
+ | "STDIN" | "STDOUT" | "STDERR" -> true
+ | _ -> false)
+ | I_func ->
+ (match ident with
+ | "abs" | "alarm" | "basename" | "bless"
+ | "caller" | "chdir" | "chmod" | "chomp" | "chop" | "chown" | "chr" | "chroot" | "close" | "closedir" | "crypt" | "delete" | "die"
+ | "each" | "eval" | "exec" | "exists" | "exit" | "fcntl" | "fileno" | "fork"
+ | "gethostbyaddr" | "gethostbyname" | "getgrnam" | "getgrgid" | "getpwent" | "getpwnam" | "getpwuid" | "gmtime" | "goto" | "grep" | "hex"
+ | "index" | "int" | "ioctl" | "join" | "keys" | "kill"
+ | "last" | "lc" | "length" | "link" | "localtime" | "log" | "lstat"
+ | "map" | "mkdir" | "next" | "oct" | "open" | "opendir" | "ord"
+ | "pack" | "pipe" | "pop" | "print" | "printf" | "push" | "quotemeta"
+ | "rand" | "read" | "readdir" | "readlink" | "redo" | "ref" | "rename" | "require" | "return" | "reverse" | "rmdir"
+ | "scalar" | "select" | "setpwent" | "shift" | "sleep" | "sort" | "splice" | "split" | "sprintf" | "stat" | "substr"
+ | "symlink" | "sysopen" | "sysread" | "sysseek" | "system" | "syswrite" | "time" | "uc" | "umask" | "unpack" | "unshift"
+ | "unlink" | "utime" | "values" | "vec" | "waitpid" | "wantarray" | "warn" | "write"
+ -> true
+
+ | _ -> false)
+ | _ -> false
+
+let check_variable (context, var) vars =
+ match var with
+ | Ident(None, ident, pos) when context <> I_func ->
+ if is_my_declared vars (context, ident) || is_our_declared vars (context, ident) ||
+ List.mem_assoc (context, ident) vars.imported || is_global_var context ident || is_global_var_declared vars (context, None, ident)
+ then ()
+ else warn_with_pos pos (sprintf "undeclared variable %s" (variable2s(context, ident)))
+ | Ident(fq, name, pos) ->
+ if context = I_func && fq = None && is_global_var context name ||
+ is_global_var_declared vars (context, fq, name)
+ then ()
+ else lpush vars.state.global_vars_used ((context, some_or fq vars.current_package, name), pos)
+ | _ -> ()
+
+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)
+ 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))
+ ) l_new ;
+ { vars with my_vars = (l_new @ l_pre) :: List.tl vars.my_vars }
+
+let declare_Our vars (ours, pos) =
+ match vars.our_vars with
+ | [] -> vars (* we're at the toplevel, already declared in global_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))
+ ) ours ;
+ { vars with our_vars = (ours @ l_pre) :: other }
+
+let declare_My_our vars (my_or_our, l, pos) =
+ match my_or_our with
+ | "my" -> declare_My vars (l, pos)
+ | "local"
+ | "our" -> declare_Our vars (l, pos)
+ | _ -> internal_error "declare_My_our"
+
+
+let check_variables vars t =
+ let rec check_variables_ vars t = fold_tree check vars t
+ and check vars = function
+ | Block l ->
+ let vars = { vars with my_vars = [] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
+ let vars = List.fold_left check_variables_ vars l in
+ let vars = { vars with my_vars = List.tl vars.my_vars ; our_vars = List.tl vars.our_vars } in
+ Some vars
+ | Call(Deref(I_func, Ident(None, "sort", _)), (Anonymous_sub(Block f) :: l)) ->
+ let vars = List.fold_left check_variables_ vars l in
+ let vars = { vars with my_vars = [ I_scalar, "a" ; I_scalar, "b" ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
+ let vars = List.fold_left check_variables_ vars f in
+ let vars = { vars with my_vars = List.tl vars.my_vars ; our_vars = List.tl vars.our_vars } in
+ Some vars
+
+ | 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" ->
+ 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
+ let vars = { vars with my_vars = List.tl vars.my_vars ; our_vars = List.tl vars.our_vars } in
+ let vars = List.fold_left check_variables_ vars other in
+ Some vars
+
+ | Sub_declaration(Ident(fq, name, pos), _proto, body) ->
+ let vars = declare_Our vars ([ I_func, (some_or fq vars.current_package) ^ "::" ^ name ], pos) in
+ let vars = check_variables_ vars body in
+ Some vars
+
+ | My_our(my_or_our, mys, pos) -> Some(declare_My_our vars (my_or_our, mys, pos))
+ | Deref(context, (Ident _ as var)) ->
+ check_variable (context, var) vars ;
+ Some vars
+ | 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
+ Some(declare_My_our vars (my_or_our, mys, pos))
+ else
+ (warn_with_pos pos "weird" ; None)
+
+ | _ -> None
+ in
+ let vars = List.fold_left check_variables_ { vars with my_vars = [[]] } t in
+ vars
+
+(*
+let check_vars vars =
+ List.iter (function
+ | I_func, (f, pos) ->
+ if not (is_our_declared vars (I_func, f)) then warn_with_pos pos ("unknown function " ^ f)
+ | _ -> ()
+ ) vars.global_vars_used
+*)
+
+let check_tree state package =
+ let imports = get_imports state package in
+ let vars = { my_vars = [[]]; our_vars = []; imported = imports; current_package = package.package_name; state = state } in
+ let _vars = check_variables vars package.body in
+ ()
diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli
new file mode 100644
index 0000000..736c68e
--- /dev/null
+++ b/perl_checker.src/tree.mli
@@ -0,0 +1,32 @@
+open Types
+
+type exports = {
+ export_ok : (context * string) list;
+ export_auto : (context * string) list;
+ export_tags : (string * (context * string) list) list;
+ re_export_all : bool;
+}
+
+
+type uses = (string * ((context * string) list option * pos)) list
+
+type per_package = {
+ file_name : string ;
+ package_name : string ; has_package_name : bool ;
+ exports : exports ;
+ uses : uses ;
+ body : fromparser list;
+ }
+type state = {
+ per_package : (string * per_package) list;
+ global_vars_declared : (context * string * string, pos) Hashtbl.t;
+ global_vars_used : ((context * string * string) * pos) list ref;
+ }
+
+val default_state : state
+val get_global_info_from_package : fromparser list -> per_package
+val get_global_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
diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli
index ceb5804..d11ff9a 100644
--- a/perl_checker.src/types.mli
+++ b/perl_checker.src/types.mli
@@ -11,9 +11,10 @@ type spaces =
| Space_cr
| Space_none
-type context = I_scalar | I_hash | I_array | I_func | I_raw | I_star | I_arraylen
+type context = I_scalar | I_hash | I_array | I_func | I_raw | I_star
type fromparser =
+ | Undef
| Ident of string option * string * pos
| Num of string * pos
| Raw_string of string * pos
@@ -36,13 +37,13 @@ type fromparser =
| Method_call of fromparser * fromparser * fromparser list
| Method_callP of fromparser * fromparser * fromparser list
- | Anonymous_sub of fromparser list
- | My of fromparser
- | Local of fromparser
+ | Anonymous_sub of fromparser
+ | My_our of string * (context * string) list * pos
| Use of fromparser * fromparser list
- | Sub_declaration of fromparser * string * fromparser list (* name, prototype, body *)
+ | Sub_declaration of fromparser * string * fromparser (* name, prototype, body *)
| Package of fromparser
| Label of string
+ | Perl_checker_comment of string * pos
| Too_complex
| Semi_colon
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-02 19:11:04 +0000