From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

RSE / slice-1.0.0 / slice_term.y 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

              
%{
##
##  slice_term.y -- YACC parser for slice terms
##  Copyright (c) 1997 Ralf S. Engelschall, All Rights Reserved. 
##
package SliceTermParser;
%}
%token SLICE
%left '\\' '-' 
%left 'u' '+'
%left 'x' '^' 
%left 'n' '*'
%right '!' '~' 
%%
expr:  SLICE            { $$ = &newvar($1); push(@OUT, $$." = \$SLICESET{'".$1."'};"); }
    |   '!' expr        { $$ = $2; push(@OUT, $2."->Complement(".$2.");"); }
    |   '~' expr        { $$ = $2; push(@OUT, $2."->Complement(".$2.");"); }
    |   expr 'n' expr   { $$ = $1; push(@OUT, $1."->Intersection(".$1.",".$3.");"); }
    |   expr '*' expr   { $$ = $1; push(@OUT, $1."->Intersection(".$1.",".$3.");"); }
    |   expr 'x' expr   { $$ = $1; push(@OUT, $1."->ExclusiveOr(".$1.",".$3.");"); }
    |   expr '^' expr   { $$ = $1; push(@OUT, $1."->ExclusiveOr(".$1.",".$3.");"); }
    |   expr 'u' expr   { $$ = $1; push(@OUT, $1."->Union(".$1.",".$3.");"); }
    |   expr '+' expr   { $$ = $1; push(@OUT, $1."->Union(".$1.",".$3.");"); }
    |   expr '\\' expr  { $$ = $1; push(@OUT, $1."->Difference(".$1.",".$3.");"); }
    |   expr '-' expr   { $$ = $1; push(@OUT, $1."->Difference(".$1.",".$3.");"); }
    |   '(' expr ')'    { $$ = $2; }
    ;
%%
#   create new set variable
$tmpcnt = 0;
sub newvar {
    local($name) = @_;
    local($tmp);
    $tmp = sprintf("\$T%03d", $tmpcnt++);
    return $tmp;
}
#   the lexical scanner
sub yylex {
    local(*s) = @_;
    local($c, $val);
    #   ignore whitespaces
    $s =~ s|^[ \t\n]+||;
    #   recognize end of string
    if ($s eq "") {
        return 0;
    }
    #   found a token
    if ($s =~ m|^([_A-Z0-9]+)(.*)|) {
        $val = $1;
        $s = $2;
        return ($SLICE, $val);
    }
    #   else give back one plain character
    $c = substr($s, 0, 1);
    $s = substr($s, 1);
    return ord($c);
}
#   and error function
sub yyerror {
    my ($msg, $s) = @_;
    die "$msg at $s.\n";
}
#
#  The top-level function which gets called by the user
#
#  ($cmds, $var) = SliceTerm::Parse($term);
#
package SliceTerm;
sub Parse {
    local($str) = @_;
    local($p, $var, $cmds);
    @SliceTermParser::OUT = ();
    $p = SliceTermParser->new(\&SliceTermParser::yylex, \&SliceTermParser::yyerror, 0);
    $var = $p->yyparse(*str);
    $cmds = join("\n", @SliceTermParser::OUT) . "\n";
    return ($cmds, $var);
}
package main;
1;
##EOF##