--- deliantra/server/lib/cf/match.pm 2009/10/10 19:11:50 1.8 +++ deliantra/server/lib/cf/match.pm 2010/03/20 20:26:18 1.25 @@ -1,3 +1,25 @@ +# +# This file is part of Deliantra, the Roguelike Realtime MMORPG. +# +# Copyright (©) 2009 Marc Alexander Lehmann / Robin Redeker / the Deliantra team +# +# Deliantra is free software: you can redistribute it and/or modify it under +# the terms of the Affero GNU General Public License as published by the +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the Affero GNU General Public License +# and the GNU General Public License along with this program. If not, see +# . +# +# The authors can be reached via e-mail to +# + =head1 NAME cf::match - object matching language @@ -5,7 +27,8 @@ =head1 DESCRIPTION This module implements a simple object matching language. It can be asked -to find any (boolean context), or all (list context), matching objects. +to find any ("check for a match"), or all ("find all objects") matching +objects. =head1 MATCH EXAMPLES @@ -26,91 +49,91 @@ type=SPELL in type=POTION in inv -Find all potions inside someones inventory, or inside applied containers: +Find all scrolls inside someones inventory, or inside applied scroll +containers: - type=POTION also in type=CONTAINER and applied in inv + type=SCROLL also in applied type=CONTAINER race="scroll" in inv -=head1 LANGUAGE +Find all unpaid items, anywhere, even deeply nested inside other items, in +the originator: - # object selection + unpaid also deep in inv of originator - select = set - | select also rep 'in' set - also = nothing | 'also' - rep = nothing | 'rep' | 'repeatedly' +=head1 MATCH EXPRESSIONS - set = 'inv' | 'env' | 'map' +=head2 STRUCTURE - empty = +The two main structures are the C, which selects objects matching +various criteria, and the C receives a set of "context objects" that it is applied +to. This is initially just one object - by default, for altars, it is the +object dropped on it, for pedestals, the object on top of it and so on. - # object matching +This set of context objects can be modified in various ways, for example +by replacing it with the inventories of all objects, or all items on the +same mapspace, and so on, by using the C operator: - match = factor - | factor 'and'? match - | factor 'or' match + condition in inv + condition in map - factor = 'not' factor - | '(' match ')' - | expr - | expr operator constant +Also, besides the default root object where all this begins, you can start +elsewhere, for example in the I (usually the player): - operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>=' + condition in inv of originator - expr = flag - | sattr - | aattr '[' ']' - | special - | func '(' args ')' - | '{' perl code block '}' +Once the final set of context objects has been established, each object +is matched against the C. - func = - sattr = - aattr = - flag = - special = +It is possible to chain modifiers from right-to-left, so this example +would start with the originator, take it's inventory, find all inventory +items which are potions, looks into their inventory, and then finds all +spells. - constant = | '"' '"' | - args = + type=SPELL in type=POTION in inv of originator - TODO: repeatedly, env, contains, possbly matches +Sometimes the server is only interested in knowing whether I +matches, and sometimes the server is interested in I objects that +match. -=head2 STRUCTURE +=head2 OPERATORS -The two main structures are the C is passed a set of "context objects" that it is applied -to. This is initially just one object - for altars, it is the object -dropped on it, for pedestals, the object on top of it and so on. +=over 4 -This set of context objects can be modified in various ways, for example -by replacing it with the inventories of all objects, or all objects on the -same mapspace, and so on, by using the C operator. +=item and, or, not, () -Once the set of context objects has been established, each object is -matched against the C expression. Sometimes the server is only -interested in knowing whether I matches, and sometimes the -server is interested in I objects that match. +Conditions can be combined with C or C to build larger +expressions. C negates the condition, and parentheses can be used to +override operator precedence and execute submatches. -=head2 OPERATORS +Not that C only negates a condition and not the whole match +expressions, thus -=over 4 + not applied in inv -=item and, or, not, () +is true if there is I non-applied object in the inventory. To negate +a whole match, you have to use a sub-match: To check whether there is +I applied object in someones inventory, write this: -Match expressions can be combined with C or C to build larger -expressions. C negates the expression, and parentheses can be used to -group match expressions. + not (applied in inv) Example: match applied weapons. - type=WEAPON and applied + applied type=WEAPON Example: match horns or rods. type=HORN or type=ROD +Example: see if the originator is a player. + + type=PLAYER of originator + =item in ... The in operator takes the context set and modifies it in various ways. As @@ -133,16 +156,24 @@ Replaces all objects by their containing object, if they have one. +=item in arch + +Replaces all objects by their archetypes. + =item in map Replaces all objects by the objects that are on the same mapspace as them. -=item in +=item in head + +Replaces all objects by their head objects. + +=item in -Finds all context objects matching the match expression, and then puts -their inventories into the context set. +Finds all context objects matching the condition, and then puts their +inventories into the context set. -Note that C is simply a special case of an C<< in >> that +Note that C is simply a special case of an C<< in >> that matches any object. Example: find all spells inside potions inside the inventory of the context @@ -159,32 +190,74 @@ type=SPELL also in inv -=item repeatedly in ... +=item also deep in ... Repeats the operation as many times as possible. This can be used to recursively look into objects. -=item also repeatedly in ... +So for example, C means to take the inventory of all +objects, taking their inventories, and so on, and adding all these objects +to the context set. -C and C can be combined. +Similarly, C means to take the environment object, their +environemnt object and so on. Example: check if there are any unpaid items in an inventory, or in the inventories of the inventory objects, and so on. - unpaid also repeatedly in inv + unpaid also deep in inv Example: check if a object is inside a player. - type=PLAYER also repeatedly in env + type=PLAYER also deep in env =back +=item of ... + +By default, all matches are applied to the "obviously appropriate" object, +such as the item dropped on a button or moving over a detector. This can +be changed to a number of other objects - not all of them are available +for each match (when not available, the match will simply fail). + +An C term ends a match, nothing is allowed to follow. + +=over 4 + +=item of object + +Starts with the default object - this is the object passed to the match to +match against by default. Matches have an explicit C appended, +but submatches start at the current object, and in this case C +can be used to start at the original object once more. + +=item of source + +Starts with the I object - this object is sometimes passed to +matches and represents the object that is the source of the action, such +as a rod or a potion when it is applied. Often, the I is the same +as the I. + +=item of originator + +Starts with the I - one step farther removed than the +I, the I is sometimes passed to matches and represents +the original initiator of an action, most commonly a player or monster. + +This object is often identical to the I (e.g. when a player casts +a spell, the player is both source and originator). + +=item of self + +Starts with the object initiating/asking for the match - this is basically +always the object that the match expression is attached to. + =back =head2 EXPRESSIONS -Match expressions usually consist of simple boolean checks (flag XYZ is -set) or simple comparisons. +Expressions used in conditions usually consist of simple boolean checks +(flag XYZ is set) or simple comparisons. =over 4 @@ -218,6 +291,13 @@ You can specify perl code to execute by putting it inside curly braces. The last expression evaluated inside will become the result. +The perlcode can access C<$_>, which rferes to the object currently being +matches, and the C<$object>, C<$self>, C<$source> and C<$originator>. + +Example: check whether the slaying field consists of digits only. + + { $_->slaying =~ /^\d+$/ } + =item comparisons, <, <=, ==, =, !=, =>, > You can compare expressions against constants via any of these @@ -249,19 +329,91 @@ This simply evaluates to true, and simply makes matching I object a bit easier to read. -=item has(match) +=item none + +This simply evaluates to false, and simply makes matching I a bit +easier to read. + +=item has(condition) True iff the object has a matching inventory object. -=item count(select) +=item count(match) + +Number of matching objects - the context object for the C is the +currently tested object - you can override this with an C for +example. + +=item dump() + +Dumps the object to the server log when executed, and evaluates to true. -Number of matching objects - the context object for the C. # TODO bullshit +Note that logical operations are short-circuiting, so this only dumps +potions: + + type=POTION and dump() =back +=head2 GRAMMAR + +This is the grammar that was used to implement the matching language +module. It is meant to be easily readable by humans, not to implement it +exactly as-is. + + # object matching and selecting + + match = chain + | chain 'of' root + root = 'object' | 'self' | 'source' | 'originator' + chain = condition + | chain also deep 'in' modifier + also = nothing | 'also' + deep = nothing | 'deep' + modifier ='inv' | 'env' | 'arch' | 'map' | 'head' + + nothing = + + # boolean matching condition + + condition = factor + | factor 'and'? condition + | factor 'or' condition + + factor = 'not' factor + | '(' match ')' + | expr + | expr operator constant + + operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>=' + + expr = flag + | sattr + | aattr '[' ']' + | 'stat.' statattr + | special + | func '(' args ')' + | '{' perl code block '}' + + func = + sattr = + aattr = + flag = + statattr = + special = + + constant = | '"' '"' | + args = + + TODO: contains, matches, query_name, selling_price, buying_price? + =cut +=head2 PERL FUNCTIONS + +=over 4 + +=cut package cf::match; @@ -269,22 +421,11 @@ use List::Util (); -# parser state -# $_ # string to be parsed -our $all; # find all, or just the first matching object - { package cf::match::exec; use List::Util qw(first); - sub env_chain { - my @res; - push @res, $_ - while $_ = $_->env; - @res - } - package cf::match::parser; use common::sense; @@ -293,13 +434,23 @@ /\G\s+/gc; } + sub condition (); + sub match ($$); + our %func = ( has => sub { - 'first { ' . &match . ' } $_->inv' + 'first { ' . condition . ' } $_->inv' }, count => sub { - local $all = 1; - '(scalar ' . &select . ')' + '(scalar ' . (match 1, '$_') . ')' + }, + dump => sub { + 'do { + warn "cf::match::match dump:\n" + . "self: " . eval { $self->name } . "\n" + . $_->as_string; + 1 + }'; }, ); @@ -307,6 +458,9 @@ any => sub { 1 }, + none => sub { + 0 + }, ); sub constant { @@ -323,7 +477,10 @@ our $flag = $cf::REFLECT{object}{flags}; our $sattr = $cf::REFLECT{object}{scalars}; + # quick hack to support archname, untested + $sattr->{archname} = "W"; our $aattr = $cf::REFLECT{object}{arrays}; + our $lattr = $cf::REFLECT{living}{scalars}; sub expr { # ws done by factor @@ -336,6 +493,16 @@ $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr"; + } elsif (/\Gstats\.([A-Za-z0-9_]+)/gc) { + + if (exists $lattr->{$1}) { + $res .= "\$_->stats->$1"; + } elsif (exists $lattr->{"\u$1"}) { + $res .= "\$_->stats->\u$1"; + } else { + die "living statistic name expected (str, pow, hp, sp...)\n"; + } + } elsif (/\G([A-Za-z0-9_]+)/gc) { if (my $func = $func{$1}) { @@ -373,6 +540,7 @@ } } else { + Carp::cluck;#d# die "expr expected\n"; } @@ -399,9 +567,10 @@ if (/\G\(/gc) { # () - $res .= &match; - ws; - /\G\)/gc or die "')' expected\n"; + + $res .= '(' . (match 0, '$_') . ')'; + + /\G\s*\)/gc or die "closing ')' expected\n"; } else { my $expr = expr; @@ -422,16 +591,20 @@ "($res)" } - sub match { + sub condition () { my $res = factor; while () { ws; - if (/\G(?=also\b|in\b|\)|$)/gc) { - # early stop => faster and requires no backtracking + + # first check some stop-symbols, so we don't have to backtrack + if (/\G(?=also\b|deep\b|in\b|of\b|\)|\z)/gc) { + pos = pos; # argh. the misop hits again. again. again. again. you die. last; + } elsif (/\Gor\b/gc) { $res .= " || "; + } else { /\Gand\b/gc; $res .= " && "; @@ -442,41 +615,95 @@ $res } - sub select { - my $res; + sub match ($$) { + my ($wantarray, $defctx) = @_; + + my $res = condition; + + # if nothing follows, we have a simple condition, so + # optimise a comon case. + if ($defctx eq '$_' and /\G\s*(?=\)|$)/gc) { + return $wantarray + ? "$res ? \$_ : ()" + : $res; + } + + $res = ($wantarray ? " grep { " : " first { ") . $res . "}"; - my $also; # undef means first iteration while () { - if (/\G\s*(inv|env|map)\b/gc) { - if ($1 eq "inv") { - $res .= " map+(${also}\$_->inv),"; - } elsif ($1 eq "env") { - $res .= " map+(${also}env_chain), "; # TODO - } elsif ($1 eq "map") { - $res .= " map+(${also}\$_->map->at (\$_->x, \$_->y)),"; + ws; + + my $also = /\Galso\s+/gc + 0; + my $deep = /\Gdeep\s+/gc + 0; + + if (/\Gin\s+/gc) { + my $expand; + + if (/\G(inv|env|map|arch|head)\b/gc) { + if ($1 eq "inv") { + $expand = "map \$_->inv,"; + } elsif ($1 eq "env") { + $expand = "map \$_->env // (),"; + } elsif ($1 eq "head") { + $expand = "map \$_->head,"; + $deep = 0; # infinite loop otherwise + } elsif ($1 eq "arch") { + $expand = "map \$_->arch,"; + $deep = 0; # infinite loop otherwise + } elsif ($1 eq "map") { + $expand = "map \$_->map->at (\$_->x, \$_->y),"; + $deep = 0; # infinite loop otherwise + } + } else { + $expand = "map \$_->inv, grep { " . condition . " }"; + } + + if ($also || $deep) { + $res .= " do {\n" + . " my \@res;\n"; + $res .= " while (\@_) {\n" if $deep; + $res .= " push \@res, \@_;\n" if $also; + $res .= " \@_ = $expand \@_;\n"; + $res .= " }\n" if $deep; + $res .= " (\@res, \@_)\n" + . "}"; + } else { + $res .= " $expand"; } - last unless /\G\s*in\b/gc; } else { - $res .= " map+($also\$_->inv)," if defined $also; - $res .= $all ? " grep { " : " first {"; - $res .= match; - $res .= "}"; - $also = /\G\s*also\b/gc ? '$_, ' : ''; - last unless /\G\s*in\b/gc; + if (/\Gof\s+(self|object|source|originator)\b/gc) { + $also || $deep + and die "neither 'also' nor 'deep' can be used with 'of'\n"; + + if ($1 eq "self") { + return "$res \$self // ()"; + } elsif ($1 eq "object") { + return "$res \$object"; + } elsif ($1 eq "source") { + return "$res \$source // ()"; + } elsif ($1 eq "originator") { + return "$res \$originator // \$source // ()"; + } + } else { + return "$res $defctx"; + } } } - - "$res \@ctx" } - } -sub parse($;$) { - local $_ = shift; - local $all = shift; +sub parse($$) { # wantarray, matchexpr + my $res; - my $res = cf::match::parser::select; + local $_ = $_[1]; + + eval { + $res = cf::match::parser::match $_[0], "\$object"; + + /\G$/gc + or die "unexpected trailing characters after match\n"; + }; if ($@) { my $ctx = 20; @@ -490,15 +717,67 @@ $res } -if (0) { - my $perl = parse '{ {1}}', 0; - - warn $perl, "\n";#d# - $perl = eval "package cf::match::exec; no warnings; no feature; our \@ctx; sub { $perl }"; die if $@; - use B::Deparse; - warn B::Deparse->new->coderef2text ($perl); +if (0) {#d# + die parse 1, 'stats.pow'; exit 0; } +our %CACHE; + +sub compile($$) { + my ($wantarray, $match) = @_; + my $expr = parse $wantarray, $match; + warn "MATCH DEBUG $match,$wantarray => $expr\n";#d# + $expr = eval " + package cf::match::exec; + sub { + my (\$object, \$self, \$source, \$originator) = \@_; + $expr + } + "; + die if $@; + + $expr +} + +=item cf::match::match $match, $object[, $self[, $source[, $originator]]] + +Compiles (and caches) the C<$match> expression and matches it against +the C<$object>. C<$self> should be the object initiating the match (or +C), C<$source> should be the actor/source and C<$originator> the +object that initiated the action (such as the player). C<$originator> +defaults to C<$source> when not given. + +In list context it finds and returns all matching objects, in scalar +context only a true or false value. + +=cut + +sub match($$;$$$) { + my $match = shift; + my $wantarray = wantarray+0; + + &{ + $CACHE{"$wantarray$match"} ||= compile $wantarray, $match + } +} + +our $CACHE_CLEARER = AE::timer 3600, 3600, sub { + %CACHE = (); +}; + +#d# $::schmorp=cf::player::find "schmorp"& +#d# cf::match::match '', $::schmorp->ob + + +=back + +=head1 AUTHOR + + Marc Lehmann + http://home.schmorp.de/ + +=cut + 1;