source/pidl/smb_interfaces.yp

   1 ########################
   2 # Parse::Yapp parser for a C header file that contains only structures
   3 # or unions.
   4
   5 # Copyright (C) 2005, Tim Potter <tpot@samba.org> released under the
   6 # GNU GPL version 2 or later
   7
   8 ################
   9 # grammar
  10
  11 %%
  12
  13 definitions:
  14         definition                      { [$_[1]] }
  15         | definitions definition        { push(@{$_[1]}, $_[2]); $_[1] }
  16 ;
  17
  18 definition:
  19         struct
  20         | union
  21         | typedef
  22         | enum
  23 ;
  24
  25 struct: STRUCT optional_identifier '{' elements '}' pointers optional_identifiers ';'
  26         {
  27                 {
  28                         "NAME" => $_[7],
  29                         "STRUCT_NAME" => $_[2],
  30                         "TYPE" => "struct",
  31                         "DATA" => $_[4],
  32                 }
  33         }
  34 ;
  35
  36 union:
  37         UNION optional_identifier '{' elements '}' pointers optional_identifier ';'
  38         {
  39                 {
  40                         "NAME" => $_[7],
  41                         "UNION_NAME" => $_[2],
  42                         "TYPE" => "union",
  43                         "DATA" => $_[4],
  44                 }
  45         }
  46 ;
  47
  48 typedef:
  49         TYPEDEF STRUCT '{' elements '}' optional_identifier ';'
  50 ;
  51
  52 enum:
  53         ENUM IDENTIFIER '{' enum_identifiers '}' ';'
  54 ;
  55
  56 enum_identifiers: enum_identifier
  57         | enum_identifiers ',' enum_identifier
  58 ;
  59
  60 enum_identifier: IDENTIFIER
  61         | IDENTIFIER '=' IDENTIFIER
  62 ;
  63
  64 elements: #empty
  65         | elements element { push(@{$_[1]}, $_[2]); $_[1] }
  66 ;
  67
  68 element:
  69         | struct
  70         | union
  71         | STRUCT IDENTIFIER pointers IDENTIFIER ';'
  72                 {{
  73                         "NAME" => [$_[2]],
  74                         "POINTERS" => $_[3],
  75                         "TYPE" => "struct $_[2]",
  76                 }}
  77         | UNION IDENTIFIER pointers IDENTIFIER ';'
  78                 {{
  79                         "NAME" => $_[2],
  80                         "POINTERS" => $_[3],
  81                         "TYPE" => "union $_[2]",
  82                 }}
  83         | CONST type pointers IDENTIFIER array ';'
  84                 {{
  85                            "NAME" => [$_[4]],
  86                            "TYPE" => $_[2],
  87                            "POINTERS" => $_[3],
  88                 }}
  89         | type pointers IDENTIFIER array ';'
  90                 {{
  91                            "NAME" => [$_[3]],
  92                            "TYPE" => $_[1],
  93                            "POINTERS" => $_[2],
  94                            "ARRAY_LENGTH" => $_[4]
  95                 }}
  96 ;
  97
  98 array: #empty
  99         | '[' CONSTANT  ']'     { int($_[2]) }
 100 ;
 101
 102 type: IDENTIFIER
 103         | ENUM IDENTIFIER
 104                 { "enum $_[2]" }
 105 ;
 106
 107 pointers:
 108    #empty { 0 }
 109    | pointers '*'  { $_[1]+1 }
 110 ;
 111
 112 optional_identifiers: optional_identifier { [$_[1]] }
 113         | optional_identifiers ',' optional_identifier { push(@{$_[1]}, $_[3]); $_[1] }
 114 ;
 115
 116 optional_identifier: IDENTIFIER | #empty { undef }
 117 ;
 118
 119 %%
 120
 121 #####################################################################
 122 # traverse a perl data structure removing any empty arrays or
 123 # hashes and any hash elements that map to undef
 124 sub CleanData($)
 125 {
 126     sub CleanData($);
 127     my($v) = shift;
 128     if (ref($v) eq "ARRAY") {
 129         foreach my $i (0 .. $#{$v}) {
 130             CleanData($v->[$i]);
 131             if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) {
 132                     $v->[$i] = undef;
 133                     next;
 134             }
 135         }
 136         # this removes any undefined elements from the array
 137         @{$v} = grep { defined $_ } @{$v};
 138     } elsif (ref($v) eq "HASH") {
 139         foreach my $x (keys %{$v}) {
 140             CleanData($v->{$x});
 141             if (!defined $v->{$x}) { delete($v->{$x}); next; }
 142             if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
 143         }
 144     }
 145         return $v;
 146 }
 147
 148 sub _Error {
 149     if (exists $_[0]->YYData->{ERRMSG}) {
 150                 print $_[0]->YYData->{ERRMSG};
 151                 delete $_[0]->YYData->{ERRMSG};
 152                 return;
 153         };
 154         my $line = $_[0]->YYData->{LINE};
 155         my $last_token = $_[0]->YYData->{LAST_TOKEN};
 156         my $file = $_[0]->YYData->{INPUT_FILENAME};
 157
 158         print "$file:$line: Syntax error near '$last_token'\n";
 159 }
 160
 161 sub _Lexer($)
 162 {
 163         my($parser)=shift;
 164
 165     $parser->YYData->{INPUT} or return('',undef);
 166
 167 again:
 168         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
 169
 170         for ($parser->YYData->{INPUT}) {
 171                 if (/^\#/) {
 172                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
 173                                 $parser->YYData->{LINE} = $1-1;
 174                                 $parser->YYData->{INPUT_FILENAME} = $2;
 175                                 goto again;
 176                         }
 177                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
 178                                 $parser->YYData->{LINE} = $1-1;
 179                                 $parser->YYData->{INPUT_FILENAME} = $2;
 180                                 goto again;
 181                         }
 182                         if (s/^(\#.*)$//m) {
 183                                 goto again;
 184                         }
 185                 }
 186                 if (s/^(\n)//) {
 187                         $parser->YYData->{LINE}++;
 188                         goto again;
 189                 }
 190                 if (s/^\"(.*?)\"//) {
 191                         $parser->YYData->{LAST_TOKEN} = $1;
 192                         return('TEXT',$1);
 193                 }
 194                 if (s/^(\d+)(\W|$)/$2/) {
 195                         $parser->YYData->{LAST_TOKEN} = $1;
 196                         return('CONSTANT',$1);
 197                 }
 198                 if (s/^([\w_]+)//) {
 199                         $parser->YYData->{LAST_TOKEN} = $1;
 200                         if ($1 =~
 201                             /^(const|typedef|union|struct|enum)$/x) {
 202                                 return uc($1);
 203                         }
 204                         return('IDENTIFIER',$1);
 205                 }
 206                 if (s/^(.)//s) {
 207                         $parser->YYData->{LAST_TOKEN} = $1;
 208                         return($1,$1);
 209                 }
 210         }
 211 }
 212
 213 sub parse($$)
 214 {
 215         my ($self,$filename) = @_;
 216
 217         my $saved_delim = $/;
 218         undef $/;
 219         my $cpp = $ENV{CPP};
 220         if (! defined $cpp) {
 221                 $cpp = "cpp"
 222         }
 223         my $data = `$cpp -D__PIDL__ -xc $filename`;
 224         $/ = $saved_delim;
 225
 226     $self->YYData->{INPUT} = $data;
 227     $self->YYData->{LINE} = 0;
 228     $self->YYData->{LAST_TOKEN} = "NONE";
 229
 230         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
 231
 232         return CleanData($idl);
 233 }