r20561: Add parser for subexpressions used in IDL attributes.

(This used to be commit 7e7fdb01d3fba449f33b7b67ba0e3a0089dd3902)

1 files changed, 116 insertions, 0 deletions

diff --git a/source4/pidl/expr.yp b/source4/pidl/expr.yp
new file mode 100644
index 0000000000..5b248ea5d6
--- /dev/null
+++ b/source4/pidl/expr.yp
@@ -0,0 +1,116 @@
+# expr.yp
+# Copyright (C) 2006 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU GPL
+# 
+%left   '->'
+%right  '!' '~' 
+%left   '*' '/' '%'
+%left   '+' '-'
+%left	'<<' '>>'
+%left   '>' '<'
+%left   '==' '!=' 
+%left   '&'
+%left   '|'
+%left   '&&'
+%left   '||'
+%left	'?' ':'
+%left   NEG DEREF ADDROF INV
+%left 	'.'
+
+%%
+exp:        NUM
+		|	TEXT				{ "\"$_[1]\"" }
+		|	func
+		|	exp '.'	VAR			{ "$_[1].$_[3]" }
+        |   VAR                 { $_[0]->Lookup($_[1]) }
+        |   '*' exp %prec DEREF { $_[0]->Dereference($_[2]); "*$_[2]" }
+        |   '~' exp %prec INV   { "~$_[2]" }
+        |   exp '+' exp         { "$_[1] + $_[3]" }
+        |   exp '-' exp         { "$_[1] - $_[3]" }
+        |   exp '*' exp         { "$_[1] * $_[3]" }
+        |   exp '%' exp         { "$_[1] % $_[3]" }
+        |   exp '<' exp         { "$_[1] < $_[3]" }
+        |   exp '>' exp         { "$_[1] > $_[3]" }
+        |   exp '|' exp         { "$_[1] | $_[3]" }
+        |   exp '==' exp         { "$_[1] == $_[3]" }
+        |   exp '<=' exp         { "$_[1] <= $_[3]" }
+        |   exp '=>' exp         { "$_[1] => $_[3]" }
+        |   exp '<<' exp         { "$_[1] << $_[3]" }
+        |   exp '>>' exp         { "$_[1] >> $_[3]" }
+        |   exp '!=' exp         { "$_[1] != $_[3]" }
+        |   exp '||' exp        { "$_[1] || $_[3]" }
+        |   exp '&&' exp        { "$_[1] && $_[3]" }
+        |   exp '&' exp         { "$_[1] & $_[3]" }
+		|	exp '->' VAR 		{ $_[1]."->".$_[3] }
+		|	exp '?' exp ':' exp { "$_[1]?$_[3]:$_[5]" }
+		|	'~' exp				{ "~$_[1]" }
+		|	'!' exp				{ "not $_[1]" }
+        |   exp '/' exp         { "$_[1] / $_[3]" }
+        |   '-' exp %prec NEG   { "-$_[2]" }
+        |   '&' exp %prec ADDROF { "&$_[2]" }
+        |   exp '^' exp         { "$_[1]^$_[3]" }
+        |   '(' exp ')'         { "($_[2])" }
+;
+
+func: VAR '(' opt_args ')' { "$_[1]($_[3])" };
+opt_args: { "" } | args;
+args: exp | exp ',' args { "$_[1], $_[3]" };
+
+%%
+
+package Parse::Pidl::Expr;
+
+sub _Lexer {
+    my($parser)=shift;
+
+    $parser->YYData->{INPUT}=~s/^[ \t]//;
+
+    for ($parser->YYData->{INPUT}) {
+        if (s/^(0x[0-9A-Fa-f]+)//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+            return('NUM',$1);
+		}
+        if (s/^([0-9]+(?:\.[0-9]+)?)//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+            return('NUM',$1);
+		}
+        if (s/^([A-Za-z_][A-Za-z0-9_]*)//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+        	return('VAR',$1);
+		}
+		if (s/^\"(.*?)\"//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('TEXT',$1); 
+		}
+		if (s/^(==|!=|<=|>=|->|\|\||<<|>>|&&)//s) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+            return($1,$1);
+		}
+        if (s/^(.)//s) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+            return($1,$1);
+		}
+    }
+}
+
+sub Lookup($$) 
+{
+	my ($self, $x) = @_;
+	return $self->YYData->{LOOKUP}->($x);
+}
+
+sub Dereference($$)
+{
+	my ($self, $x) = @_;
+	if (defined($self->YYData->{DEREFERENCE})) {
+		$self->YYData->{DEREFERENCE}->($x);
+	}
+}
+
+sub Run {
+    my($self, $data, $error, $lookup, $deref) = @_;
+    $self->YYData->{INPUT} = $data;
+    $self->YYData->{LOOKUP} = $lookup;
+    $self->YYData->{DEREFERENCE} = $deref;
+    return $self->YYParse( yylex => \&_Lexer, yyerror => $error );
+}