1#!/usr/bin/perl
2
3use Data::Dumper;
4
5$express= {
6	   type=>'AND',
7#	   type=>'OR',
8#	   arg1=>{type=>'REF', arg1=>'a'},
9	   arg1=>{type=>'NOT', arg1=>{type=>'REF', arg1=>'a'}},
10   	   arg2=>{type=>'REF', arg1=>'b'}
11	  };
12
13$list= ['a','b', 'ab','abc', 'ac', 'c','bc'];
14
15#print Dumper($express);
16#print Dumper($list);
17
18# WARNING: NOT doesn't work properly unless it's surrounded by parenthesis
19
20#$string= "a AND (NOT c) AND b";
21#$string= "NOT (a AND b AND c)";
22#$string= "(a AND (NOT b)) OR (b AND (NOT a))";
23#$string= "(a OR b) AND (NOT (a AND b))";
24$string= "(a) AND (b)";
25$express= read_express(\$string);
26print Dumper($express),"\n";
27print join(" ",@{eval_express($express, $list)}),"\n";
28
29sub eval_express{
30  my $express= shift;
31  my $list= shift;
32
33  my $type= $express->{type};
34  my $arg1= $express->{arg1};
35  my $arg2= $express->{arg2};
36  if ($type eq 'AND'){
37    return(eval_express($arg2, eval_express($arg1,$list)));
38  }
39  elsif ($type eq 'OR'){
40    my $list1= eval_express($arg1, $list);
41    my $list2= eval_express($arg2, $list);
42    return([@$list1,@$list2]);
43  }
44  elsif ($type eq 'XOR'){
45    my $list1= eval_express($arg1, $list);
46    my $list2= eval_express($arg2, $list);
47    my %remove=();
48    for my $item (@$list1){
49      $remove{$item}=1;
50    }
51    my @lnew=();
52    for my $item (@$list2){
53      push @lnew, $item if (!($remove{$item}));
54    }
55    return([@lnew]);
56  }
57  elsif ($type eq 'NOT'){
58    my $list1= eval_express($arg1, $list);
59    my %remove=();
60    for my $item (@$list1){
61      $remove{$item}=1;
62    }
63    my @lnew=();
64    for my $item (@$list){
65      push @lnew, $item if (!($remove{$item}));
66    }
67    return([@lnew]);
68  }
69  elsif ($type eq 'REF'){
70    my @lnew= ();
71    for my $item (@$list){
72      if ($item=~ /$arg1/){
73	push @lnew, $item;
74      }
75    }
76    return([@lnew]);
77  }
78  else {
79    return("");
80  }
81}
82
83{
84  my $open=0;
85
86  sub read_express {
87    my $string= shift;
88    my $express="";
89    my $expect_arg1=0;
90    my $expect_arg2=0;
91    while ($$string ne ""){
92      my $nh={};
93      $$string=~ s/^\s+//;
94      if ($$string=~ s/^\(// ){
95	++$open;
96	$nh= read_express($string);
97      }
98      elsif ($$string=~ s/^AND\s+//){
99	$nh->{type}= 'AND';
100	die "Null first operand for AND" unless ($express ne "");
101	$nh->{arg1}= $express;
102	$express= $nh;
103	$expect_arg2=1;
104	next;
105      }
106      elsif ($$string=~ s/^OR\s+//){
107	$nh->{type}= 'OR';
108	die "Null first operand for OR" unless ($express ne "");
109	$nh->{arg1}= $express;
110	$express= $nh;
111	$expect_arg2=1;
112	next;
113      }
114      elsif ($$string=~ s/^XOR\s+//){
115	die "XOR not yet implemented";
116	$nh->{type}= 'XOR';
117	die "Null first operand for XOR" unless ($express ne "");
118	$nh->{arg1}= $express;
119	$express= $nh;
120	$expect_arg2=1;
121	next;
122      }
123      elsif ($$string=~ s/^NOT\s+//){
124	$nh->{type}= 'NOT';
125	$express= $nh;
126	$expect_arg1=1;
127	next;
128      }
129      elsif ($$string=~ s/^([^\s\)]+)//){
130	$nh->{type}='REF';
131	$nh->{arg1}=$1;
132      }
133      elsif ($$string=~ s/^\)// ){
134	--$open;
135	die "Unmatched end parenthesis" if ($open<0);
136	die "Empty parenthesis" if ($express eq "");
137	return($express);
138      }
139      # print Dumper($nh),"\n";
140      if ($express eq ""){
141	$express= $nh;
142      }
143      elsif($expect_arg1){
144	$express->{arg1}=$nh;
145	$expect_arg1=0;
146      }
147      elsif($expect_arg2){
148	$express->{arg2}=$nh;
149	$expect_arg2=0;
150      }
151      else{
152	die "Expression without operator";
153      }
154    }
155    if ($expect_arg1){
156      die "Missing unary operand";
157    }
158    if ($expect_arg2){
159      die "Missing binary operand";
160    }
161    die "Missing end parenthesis" unless ($open==0);
162    return($express);
163  }
164}
165