*** empty log message ***

1 files changed, 307 insertions, 0 deletions

diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
new file mode 100644
index 0000000..0f5f34b
--- /dev/null
+++ b/perl_checker.src/parser.mly
@@ -0,0 +1,307 @@
+%{ (* -*- caml -*- *)
+  open Types
+  open Common
+
+  let parse_error _ =
+   failwith (Info.pos2sfull_current (Parsing.symbol_start()) (Parsing.symbol_end()) ^ "parse error")   
+
+  let to_Ident = function
+   | BAREWORD(name, pos) -> Ident(I_raw, None, name, pos)
+   | SCALAR_IDENT(fq, name, pos) -> Ident(I_scalar, fq, name, pos)
+   | ARRAY_IDENT (fq, name, pos) -> Ident(I_array,  fq, name, pos)
+   | HASH_IDENT  (fq, name, pos) -> Ident(I_hash,   fq, name, pos)
+   | FUNC_IDENT  (fq, name, pos) -> Ident(I_func,   fq, name, pos)
+   | STAR_IDENT  (fq, name, pos) -> Ident(I_star,   fq, name, pos)
+   | RAW_IDENT   (fq, name, pos) -> Ident(I_raw,    fq, name, pos)
+   | _ -> internal_error "Parser.to_Ident"
+%}
+
+
+%token EOF
+%token <Types.pos> SPACE
+%token <string * Types.pos> NUM STRING BAREWORD PROTOTYPE REVISION COMMENT POD LABEL
+%token <string * Types.pos> COMMAND_STRING QUOTEWORDS
+%token <(string * Types.pos) ref> HERE_DOC
+%token <string * string * Types.pos> PATTERN
+%token <string * string * string * Types.pos> PATTERN_SUBST
+
+%token <string option * string * Types.pos> SCALAR_IDENT ARRAY_IDENT HASH_IDENT FUNC_IDENT STAR_IDENT RAW_IDENT ARRAYLEN_IDENT
+
+%token IF ELSIF ELSE UNLESS DO WHILE UNTIL MY CONTINUE SUB LOCAL
+%token <string> FOR
+%token USE PACKAGE FORMAT
+%token <Types.pos> PRINT NEW
+%token AT DOLLAR PERCENT AMPERSAND STAR ARRAYLEN
+%token SEMI_COLON PKG_SCOPE
+%token PAREN PAREN_END
+%token BRACKET BRACKET_END
+%token ARRAYREF ARRAYREF_END
+
+
+%token ARROW
+%token INCR DECR
+%token POWER
+%token TIGHT_NOT BIT_NEG REF
+%token PATTERN_MATCH PATTERN_MATCH_NOT
+%token MULT DIVISION MODULO REPLICATE
+%token PLUS MINUS CONCAT
+%token BIT_SHIFT_LEFT BIT_SHIFT_RIGHT
+%token <string> COMPARE_OP EQ_OP
+%token BIT_AND
+%token BIT_OR BIT_XOR
+%token AND_TIGHT
+%token OR_TIGHT
+%token DOTDOT DOTDOTDOT
+%token QUESTION_MARK COLON
+%token <string> ASSIGN
+%token COMMA RIGHT_ARROW
+%token NOT
+%token AND
+%token OR XOR
+
+%nonassoc PREC_LOW
+%nonassoc LOOPEX
+
+%left       OR XOR
+%left       AND
+%right      NOT
+%nonassoc   LSTOP
+%left   COMMA RIGHT_ARROW
+
+%right      ASSIGN
+%right      QUESTION_MARK COLON
+%nonassoc   DOTDOT DOTDOTDOT
+%left       OR_TIGHT
+%left       AND_TIGHT
+%left       BIT_OR BIT_XOR
+%left       BIT_AND
+%nonassoc   EQ_OP
+%nonassoc   COMPARE_OP
+%nonassoc   UNIOP
+%left       BIT_SHIFT_LEFT BIT_SHIFT_RIGHT
+%left       PLUS MINUS CONCAT
+%left       MULT DIVISION MODULO REPLICATE
+%left       PATTERN_MATCH PATTERN_MATCH_NOT
+%right      TIGHT_NOT BIT_NEG REF UNARY_MINUS
+%right      POWER
+%nonassoc   INCR DECR
+%left       ARROW
+
+%nonassoc PAREN_END
+%left PAREN
+%left ARRAYREF BRACKET
+
+%type <string> prog
+
+%start prog
+
+
+%%
+prog: lineseq EOF { "" }
+
+block: BRACKET lineseq BRACKET_END { $2 }
+
+lineseq: /* A collection of "lines" in the program */
+|              {[]}
+| decl lineseq {[]}
+| label line {[]}
+
+line:
+| if_then_else lineseq { [] }
+| loop lineseq { [] }
+| SEMI_COLON lineseq { [] }
+| sideff SEMI_COLON lineseq { [] }
+
+| sideff { [] }
+
+
+if_then_else: /* Real conditional expressions */
+| IF     PAREN expr PAREN_END block elsif else_ {[]}
+| UNLESS PAREN expr PAREN_END block elsif else_ {[]}
+
+elsif:
+|  { [] }
+| ELSIF PAREN expr PAREN_END block elsif { [ $3, $5 ] @ $6 }
+
+else_: 
+|            { None }
+| ELSE block { Some $2 }
+
+loop:
+| WHILE PAREN expr_or_empty PAREN_END block cont {[]}
+| UNTIL PAREN expr PAREN_END block cont {[]}
+| FOR MY SCALAR_IDENT PAREN expr PAREN_END block cont {[]}
+| FOR SCALAR_IDENT PAREN expr PAREN_END block cont {[]}
+| FOR PAREN expr PAREN_END block cont {[]}
+| FOR PAREN expr_or_empty ';' expr_or_empty ';' expr_or_empty PAREN_END block {[]}
+| block cont {[]} /* a block is a loop that happens once */
+
+cont: /* Continue blocks */
+|  {[]}
+| CONTINUE block {[]}
+
+sideff: /* An expression which may have a side-effect */
+| error { [] }
+| expr { $1 }
+| expr   IF    expr { [ (*Binary("if",      $1, $3)*) ] }
+| expr UNLESS  expr { [ (*Binary("unless",  $1, $3)*) ] }
+| expr  WHILE  expr { [ (*Binary("while",   $1, $3)*) ] }
+| expr  UNTIL  expr { [ (*Binary("until",   $1, $3)*) ] }
+| expr  FOR    expr { [ (*Binary($2,        $1, $3)*) ] }
+
+decl:
+| FORMAT formname block {[]}
+| SUB word prototype_or_empty subbody {[]}
+| PACKAGE word SEMI_COLON {[]}
+| USE word_or_empty revision_or_empty listexpr SEMI_COLON {[]}
+
+formname: {[]} | BAREWORD {[]}
+subbody: block { $1 } | SEMI_COLON {[]}
+
+
+listexpr: /* Basic list expressions */
+| %prec PREC_LOW {[]}
+| argexpr %prec PREC_LOW {[]}
+
+expr: /* Ordinary expressions; logical combinations */
+| expr AND expr {[]}
+| expr OR expr {[]}
+| argexpr %prec PREC_LOW {[]}
+
+argexpr: /* Expressions are a list of terms joined by commas */
+| argexpr comma {[]}
+| argexpr comma term {[]}
+| term %prec PREC_LOW {[]}
+
+term:
+| term binop term {[]}
+| termunop {[]}
+| anonymous {[]}
+| termdo {[]}
+| term QUESTION_MARK term COLON term {[]}
+| REF term {[]} /* \$x, \@y, \%z */
+| MY myterm     %prec UNIOP {[]}
+| LOCAL term    %prec UNIOP {[]}
+| PAREN expr_or_empty PAREN_END {[]}
+
+| scalar        %prec PAREN {[]}
+| star          %prec PAREN {[]}
+| hash          %prec PAREN {[]}
+| array         %prec PAREN {[]}
+| arraylen      %prec PAREN {[]} /* $#x, $#{ something } */
+
+| subscripted {[]}
+
+| PAREN expr_or_empty PAREN_END ARRAYREF expr ARRAYREF_END {[]} /* list slice */
+| array ARRAYREF expr ARRAYREF_END {[]} /* array slice */
+| array BRACKET expr BRACKET_END {[]} /* @hash{@keys} */
+
+| function_call {[]}
+
+| word {[]}
+| NUM {[]}
+| STRING {[]}
+| REVISION {[]}
+| COMMAND_STRING {[]}
+| QUOTEWORDS {[]}
+| HERE_DOC {[]}
+
+function_call:
+| func {[]} /* &foo; */
+| func PAREN expr_or_empty PAREN_END {[]} /* &foo(@args) */
+| word argexpr {[]} /* foo(@args) */
+| word block listexpr %prec LSTOP {[]} /* map { foo } @bar */
+
+| term ARROW word_or_scalar PAREN expr_or_empty PAREN_END {[]} /* $foo->bar(list) */
+| term ARROW word_or_scalar {[]} /* $foo->bar */
+
+| NEW word listexpr {[]} /* new Class @args */
+| PRINT word_or_scalar argexpr {[]} /* print $fh @args */
+
+termdo: /* Things called with "do" */
+| DO term %prec UNIOP                               {[]} /* do $filename */
+| DO block %prec PAREN                   {[]} /* do { code */
+
+termunop: /* Unary operators and terms */
+| MINUS term %prec UNARY_MINUS {[]}
+| TIGHT_NOT term {[]}
+| BIT_NEG term {[]}
+| INCR term    {[]}
+| DECR term    {[]}
+| term INCR    {[]}
+| term DECR    {[]}
+
+| NOT argexpr  {[]}
+
+myterm: /* Things that can be "my"'d */
+| PAREN expr_or_empty PAREN_END {[]}
+| scalar {[]}
+| hash {[]}
+| array {[]}
+
+subscripted: /* Some kind of subscripted expression */
+| star PKG_SCOPE BRACKET expr BRACKET_END {[]} /* *main::{something} */
+| scalar ARRAYREF expr ARRAYREF_END         {[]} /* $array[$element] */
+| scalar BRACKET expr BRACKET_END           {[]} /* $foo{bar} */
+| term ARROW ARRAYREF expr ARRAYREF_END     {[]} /* somearef->[$element] */
+| term ARROW BRACKET expr BRACKET_END       {[]} /* somehref->{bar} */
+| term ARROW PAREN expr_or_empty PAREN_END  {[]} /* $subref->(@args) */
+| subscripted ARRAYREF expr ARRAYREF_END    {[]} /* $foo->[$bar][$baz] */
+| subscripted BRACKET expr BRACKET_END      {[]} /* $foo->[bar]{baz;} */
+| subscripted PAREN expr_or_empty PAREN_END {[]} /* $foo->{bar}(@args) */
+
+binop:
+| ASSIGN {[]}
+| POWER {[]}
+| MULT {[]} | DIVISION {[]} | MODULO {[]} | REPLICATE {[]}
+| PLUS {[]} | MINUS {[]} | CONCAT {[]}
+| BIT_SHIFT_LEFT {[]} | BIT_SHIFT_RIGHT {[]}
+| COMPARE_OP {[]}
+| EQ_OP {[]}
+| BIT_AND {[]}
+| BIT_OR {[]} | BIT_XOR {[]}
+| DOTDOT {[]} | DOTDOTDOT {[]}
+| AND_TIGHT {[]}
+| OR_TIGHT {[]} | XOR {[]}
+| PATTERN_MATCH {[]} | PATTERN_MATCH_NOT {[]}
+
+anonymous: /* Constructors for anonymous data */
+| ARRAYREF expr_or_empty ARRAYREF_END {[]}
+| BRACKET expr_or_empty BRACKET_END %prec PAREN {[]} /* { foo => "Bar" } */
+| SUB prototype_or_empty block %prec PAREN {[]}
+
+label:
+|                 { None }
+| BAREWORD COLON { Some $1 }
+
+word:
+| bareword { fst $1 }
+| RAW_IDENT { 
+    match $1 with
+    | None, name, _ -> name
+    | Some s, name, _ -> s ^ "::" ^ name
+  }
+
+comma: COMMA {[]} | RIGHT_ARROW {[]}
+
+word_or_scalar:
+| bareword     { [] }
+| RAW_IDENT    { [] }
+| SCALAR_IDENT { [] }
+
+bareword:
+| NEW { "new", $1 }
+| PRINT { "print", $1 }
+| BAREWORD { $1 }
+
+arraylen: ARRAYLEN_IDENT {[]} | ARRAYLEN block {[]}
+scalar: SCALAR_IDENT {[]} | DOLLAR    block {[]}
+func:   FUNC_IDENT   {[]} | AMPERSAND block {[]}
+array:  ARRAY_IDENT  {[]} | AT        block {[]}
+hash:   HASH_IDENT   {[]} | PERCENT   block {[]}
+star:   STAR_IDENT   {[]} | STAR      block {[]}
+
+expr_or_empty: {[]} | expr {[]}
+word_or_empty: {[]} | word {[]}
+prototype_or_empty: {[]} | PROTOTYPE {[]}
+revision_or_empty: {[]} | REVISION {[]}