#################################################################### # # This file was generated using Parse::Yapp version 1.05. # # Don't edit this file, use source file instead. # # ANY CHANGE MADE HERE WILL BE LOST ! # #################################################################### package TM::AsTMa::Fact2; use vars qw ( @ISA ); use strict; @ISA= qw ( Parse::Yapp::Driver ); use Parse::Yapp::Driver; #line 1 "yapp/astma2-fact.yp" use Data::Dumper; use TM; use TM::Literal; use constant { XSD => 'http://www.w3.org/2001/XMLSchema', XSD_STRING => 'http://www.w3.org/2001/XMLSchema#string', ASTMA => 'http://psi.tm.bond.edu.au/astma/2.0/', ONTOLOGY => 'http://psi.tm.bond.edu.au/astma/2.0/#ontology', TEMPLATE => 'http://psi.tm.bond.edu.au/astma/2.0/#template' }; sub _expand_template { my $store = shift; my $ted = shift; my $params = shift; # they are all strings at this level #warn "params".Dumper $params; my @returns = $store->match (TM->FORALL, type => 'return', irole => 'thing', iplayer => $store->tids ($ted) ) or die "template '$ted' does not have a 'return' characteristic"; #warn Dumper \@returns; my $return = $returns[0]->[TM->PLAYERS]->[1] and (scalar @returns == 1 or die "ambiguous 'return' characteristics for '$ted'"); my $value = $return->[0] and ($return->[1] eq 'http://www.w3.org/2001/XMLSchema#string' or die "'return' characteristic of '$ted' is no string"); #warn "template id '$ted' >>>$value<<<"; foreach my $p (keys %$params) { $value =~ s/{\s*\$$p\s*}/$params->{$p}/sg; } #warn "after template id '$ted' >>>$value<<<"; die "variable '$1' in template '$ted' has no value at expansion" if $value =~ /{\s*(\$\w+)\s*}/; return $value; } sub new { my $class = shift; my %options = @_; my $store = delete $options{store} || new TM; # the Yapp parser is picky and interprets this :-/ ref($class) and $class=ref($class); my $self = $class->SUPER::new( ## yydebug => 0x01, yyversion => '1.05', yystates => [ {#State 0 DEFAULT => -1, GOTOS => { 'instance' => 1 } }, {#State 1 ACTIONS => { '' => 2, 'LOG' => 10, 'EOL' => 13, 'CANCEL' => 4, 'INCLUDE' => 6, 'TED' => 5, 'ENCODING' => 7, 'VERSION' => 11 }, DEFAULT => -4, GOTOS => { '@1-0' => 8, 'clause' => 9, 'template_expansion' => 3, 'directive' => 12 } }, {#State 2 DEFAULT => 0 }, {#State 3 DEFAULT => -6 }, {#State 4 DEFAULT => -8 }, {#State 5 ACTIONS => { 'LPAREN' => 14 }, DEFAULT => -14, GOTOS => { 'parameters' => 15 } }, {#State 6 DEFAULT => -11 }, {#State 7 DEFAULT => -12 }, {#State 8 ACTIONS => { 'BRA' => 17 }, DEFAULT => -22, GOTOS => { '@3-0' => 18, 'topic' => 16, 'theme' => 19 } }, {#State 9 DEFAULT => -3 }, {#State 10 DEFAULT => -9 }, {#State 11 DEFAULT => -10 }, {#State 12 DEFAULT => -7 }, {#State 13 DEFAULT => -2 }, {#State 14 ACTIONS => { 'ID' => 20 }, GOTOS => { 'bindings' => 21, 'binding' => 22 } }, {#State 15 DEFAULT => -13 }, {#State 16 DEFAULT => -21 }, {#State 17 DEFAULT => -22, GOTOS => { '@3-0' => 18, 'topic' => 23 } }, {#State 18 DEFAULT => -44, GOTOS => { 'attachments' => 24 } }, {#State 19 ACTIONS => { 'DOT' => 25 } }, {#State 20 ACTIONS => { 'COLON' => 26 } }, {#State 21 ACTIONS => { 'RPAREN' => 27, 'COMMA' => 28 } }, {#State 22 DEFAULT => -16 }, {#State 23 ACTIONS => { 'KET' => 29 } }, {#State 24 ACTIONS => { 'ID' => 30, 'HAS' => 31, 'DATE' => 32, 'WILDCARD' => 33, 'WHICH' => 35, 'EQUAL' => 36, 'EOL' => 38, 'SUBCL' => 39, 'REIFIES' => 40, 'URI' => 41, 'TED' => 45, 'ISA' => 46, 'TILDE' => 47 }, DEFAULT => -24, GOTOS => { 'expansion' => 42, 'predefined_inlines' => 43, 'association' => 37, 'identification' => 44, 'tid' => 34 } }, {#State 25 DEFAULT => -5 }, {#State 26 DEFAULT => -18, GOTOS => { '@2-2' => 48 } }, {#State 27 DEFAULT => -15 }, {#State 28 ACTIONS => { 'ID' => 20 }, GOTOS => { 'binding' => 49 } }, {#State 29 DEFAULT => -20 }, {#State 30 DEFAULT => -68 }, {#State 31 ACTIONS => { 'ID' => 30, 'URI' => 41, 'EQUAL' => 36, 'TILDE' => 47, 'DATE' => 32, 'WILDCARD' => 33 }, GOTOS => { 'characteristic' => 51, 'tid' => 50 } }, {#State 32 DEFAULT => -70 }, {#State 33 DEFAULT => -69 }, {#State 34 DEFAULT => -61 }, {#State 35 ACTIONS => { 'TED' => 45, 'HAS' => 52, 'ISA' => 46, 'SUBCL' => 39 }, GOTOS => { 'expansion' => 53, 'predefined_inlines' => 43 } }, {#State 36 ACTIONS => { 'URI' => 54 } }, {#State 37 DEFAULT => -23 }, {#State 38 ACTIONS => { 'ID' => 30, 'URI' => 41, 'EQUAL' => 36, 'TILDE' => 47, 'DATE' => 32, 'WILDCARD' => 33 }, GOTOS => { 'identification' => 55, 'tid' => 34 } }, {#State 39 DEFAULT => -56 }, {#State 40 DEFAULT => -25, GOTOS => { '@4-1' => 56 } }, {#State 41 DEFAULT => -73 }, {#State 42 DEFAULT => -47 }, {#State 43 ACTIONS => { 'LPAREN' => 14 }, DEFAULT => -14, GOTOS => { 'parameters' => 57 } }, {#State 44 DEFAULT => -49 }, {#State 45 DEFAULT => -57 }, {#State 46 DEFAULT => -55 }, {#State 47 ACTIONS => { 'URI' => 58 } }, {#State 48 ACTIONS => { 'VALUE' => 59 } }, {#State 49 DEFAULT => -17 }, {#State 50 ACTIONS => { 'AT' => 60 }, DEFAULT => -64, GOTOS => { 'scope' => 61 } }, {#State 51 DEFAULT => -45 }, {#State 52 ACTIONS => { 'ID' => 30, 'URI' => 41, 'EQUAL' => 36, 'TILDE' => 47, 'DATE' => 32, 'WILDCARD' => 33 }, GOTOS => { 'characteristic' => 62, 'tid' => 50 } }, {#State 53 DEFAULT => -48 }, {#State 54 DEFAULT => -71 }, {#State 55 DEFAULT => -50 }, {#State 56 ACTIONS => { 'ID' => 30, 'URI' => 41, 'EQUAL' => 36, 'TILDE' => 47, 'DATE' => 32, 'WILDCARD' => 33 }, GOTOS => { 'identification' => 63, 'tid' => 34 } }, {#State 57 DEFAULT => -58, GOTOS => { '@10-2' => 64 } }, {#State 58 DEFAULT => -72 }, {#State 59 DEFAULT => -19 }, {#State 60 ACTIONS => { 'ID' => 30, 'URI' => 41, 'EQUAL' => 36, 'TILDE' => 47, 'DATE' => 32, 'WILDCARD' => 33 }, GOTOS => { 'tid' => 65 } }, {#State 61 ACTIONS => { 'SUBCL' => 66 }, DEFAULT => -66, GOTOS => { 'type' => 67 } }, {#State 62 DEFAULT => -46 }, {#State 63 DEFAULT => -26, GOTOS => { '@5-3' => 68 } }, {#State 64 ACTIONS => { 'ID' => 30, 'URI' => 41, 'EQUAL' => 36, 'TILDE' => 47, 'DATE' => 32, 'WILDCARD' => 33 }, GOTOS => { 'identification' => 69, 'tid' => 34 } }, {#State 65 DEFAULT => -65 }, {#State 66 ACTIONS => { 'ID' => 30, 'URI' => 41, 'EQUAL' => 36, 'TILDE' => 47, 'DATE' => 32, 'WILDCARD' => 33 }, GOTOS => { 'tid' => 70 } }, {#State 67 ACTIONS => { 'COLON' => 71 } }, {#State 68 ACTIONS => { 'AT' => 60 }, DEFAULT => -64, GOTOS => { 'scope' => 72 } }, {#State 69 DEFAULT => -59, GOTOS => { '@11-4' => 73 } }, {#State 70 DEFAULT => -67 }, {#State 71 DEFAULT => -62, GOTOS => { '@12-4' => 74 } }, {#State 72 ACTIONS => { 'LPAREN' => 75, 'EOL' => 76 }, GOTOS => { 'rolesin' => 77 } }, {#State 73 ACTIONS => { 'DOWNCOMMA' => 79 }, DEFAULT => -51, GOTOS => { 'relative' => 78 } }, {#State 74 ACTIONS => { 'VALUE' => 80 } }, {#State 75 DEFAULT => -28 }, {#State 76 DEFAULT => -29 }, {#State 77 DEFAULT => -22, GOTOS => { '@3-0' => 18, 'roles' => 82, 'topic' => 81, 'role' => 83 } }, {#State 78 DEFAULT => -60 }, {#State 79 DEFAULT => -44, GOTOS => { 'attachments' => 84 } }, {#State 80 DEFAULT => -63 }, {#State 81 DEFAULT => -37, GOTOS => { '@6-1' => 85 } }, {#State 82 ACTIONS => { 'RPAREN' => 86, 'COMMA' => 88, 'EOL' => 87 }, DEFAULT => -30, GOTOS => { 'rolesout' => 89, 'rolesep' => 90 } }, {#State 83 DEFAULT => -35 }, {#State 84 ACTIONS => { 'ID' => 30, 'HAS' => 31, 'DATE' => 32, 'WILDCARD' => 33, 'WHICH' => 35, 'EQUAL' => 36, 'EOL' => 38, 'SUBCL' => 39, 'URI' => 41, 'COMMA' => 92, 'TED' => 45, 'TILDE' => 47, 'ISA' => 46 }, DEFAULT => -53, GOTOS => { 'expansion' => 42, 'upcomma' => 91, 'predefined_inlines' => 43, 'identification' => 44, 'tid' => 34 } }, {#State 85 ACTIONS => { 'COLON' => 93 } }, {#State 86 DEFAULT => -31 }, {#State 87 ACTIONS => { 'COLON' => -32, 'DOT' => -32, 'KET' => -32 }, DEFAULT => -34 }, {#State 88 DEFAULT => -33 }, {#State 89 DEFAULT => -27 }, {#State 90 DEFAULT => -22, GOTOS => { '@3-0' => 18, 'topic' => 81, 'role' => 94 } }, {#State 91 DEFAULT => -52 }, {#State 92 DEFAULT => -54 }, {#State 93 DEFAULT => -38, GOTOS => { '@7-3' => 95 } }, {#State 94 DEFAULT => -36 }, {#State 95 ACTIONS => { 'ID' => 30, 'URI' => 41, 'EQUAL' => 36, 'TILDE' => 47, 'DATE' => 32, 'WILDCARD' => 33 }, GOTOS => { 'identification' => 97, 'identifications' => 96, 'tid' => 34 } }, {#State 96 ACTIONS => { 'ID' => 30, 'URI' => 41, 'DATE' => 32, 'WILDCARD' => 33, 'EQUAL' => 36, 'TILDE' => 47 }, DEFAULT => -39, GOTOS => { 'identification' => 98, 'tid' => 34 } }, {#State 97 DEFAULT => -40, GOTOS => { '@8-1' => 99 } }, {#State 98 DEFAULT => -42, GOTOS => { '@9-2' => 100 } }, {#State 99 DEFAULT => -41 }, {#State 100 DEFAULT => -43 } ], yyrules => [ [#Rule 0 '$start', 2, undef ], [#Rule 1 'instance', 0, undef ], [#Rule 2 'instance', 2, undef ], [#Rule 3 'instance', 2, undef ], [#Rule 4 '@1-0', 0, sub #line 96 "yapp/astma2-fact.yp" { $_[0]->{USER}->{ctx} = undef; } ], [#Rule 5 'clause', 3, undef ], [#Rule 6 'clause', 1, undef ], [#Rule 7 'clause', 1, undef ], [#Rule 8 'directive', 1, sub #line 102 "yapp/astma2-fact.yp" { die "Cancelled"; } ], [#Rule 9 'directive', 1, sub #line 103 "yapp/astma2-fact.yp" { warn $_[1]; 1; } ], [#Rule 10 'directive', 1, sub #line 104 "yapp/astma2-fact.yp" { die "unsupported version $_[1]" unless $_[1] =~ /^2\./; 1; } ], [#Rule 11 'directive', 1, sub #line 105 "yapp/astma2-fact.yp" { my $content; if ($_[1] =~ /\|\s*$/) { # a pipe | at the end, this is a UNIX pipe my $fh = IO::File->new ($_[1]) || die "unable to open pipe '$_[1]'"; local $/ = undef; $content = <$fh>; $fh->close; } else { use LWP::Simple; $content = get($_[1]) || die "unable to load '$_[1] with LWP'\n"; } #warn "new content >>>$content<<<"; $_[0]->YYData->{INPUT} = $content . $_[0]->YYData->{INPUT}; # prepend it } ], [#Rule 12 'directive', 1, sub #line 120 "yapp/astma2-fact.yp" { use Encode; Encode::from_to ($_[0]->YYData->{INPUT}, "iso-8859-1", $_[1]); } ], [#Rule 13 'template_expansion', 2, sub #line 126 "yapp/astma2-fact.yp" { $_[0]->YYData->{INPUT} .= "\n" . _expand_template ($_[0]->{USER}->{store}, $_[1], $_[2]) # compute the expanded version . "\n"; # extend the text at the end; } ], [#Rule 14 'parameters', 0, sub #line 135 "yapp/astma2-fact.yp" { { } } ], [#Rule 15 'parameters', 3, sub #line 136 "yapp/astma2-fact.yp" { $_[2] } ], [#Rule 16 'bindings', 1, undef ], [#Rule 17 'bindings', 3, sub #line 140 "yapp/astma2-fact.yp" { $_[1] = { %{$_[1]}, %{$_[3]} }; $_[1]; } ], [#Rule 18 '@2-2', 0, sub #line 143 "yapp/astma2-fact.yp" { $_[0]->{USER}->{value} = 1 } ], [#Rule 19 'binding', 4, sub #line 143 "yapp/astma2-fact.yp" { { "$_[1]" => $_[4]->[0] } } ], [#Rule 20 'theme', 3, undef ], [#Rule 21 'theme', 1, undef ], [#Rule 22 '@3-0', 0, sub #line 150 "yapp/astma2-fact.yp" { unshift @{$_[0]->{USER}->{ctx}}, undef; } ], [#Rule 23 'topic', 3, undef ], [#Rule 24 'association', 0, undef ], [#Rule 25 '@4-1', 0, sub #line 156 "yapp/astma2-fact.yp" { $_[0]->{USER}->{reifier} = $_[0]->{USER}->{ctx}->[0]; $_[0]->{USER}->{ctx}->[0] = undef; } ], [#Rule 26 '@5-3', 0, sub #line 159 "yapp/astma2-fact.yp" { $_[0]->{USER}->{atype} = $_[0]->{USER}->{ctx}->[0]; $_[0]->{USER}->{assoc} = 1; # indicate to lexer that we are in assoc context } ], [#Rule 27 'association', 8, sub #line 164 "yapp/astma2-fact.yp" { # warn "roles :". Dumper $_[7]; $_[0]->{USER}->{store}->assert ([ $_[0]->{USER}->{reifier}, # LID $_[5], # SCOPE $_[0]->{USER}->{atype}, # TYPE TM->ASSOC, # KIND @{$_[7]}, # ROLES, PLAYERS undef ] ); $_[0]->{USER}->{implicits}->{'isa-scope'}->{$_[5]}++ if $_[5]; $_[0]->{USER}->{assoc} = undef; # indicate to lexer that we left assoc context } ], [#Rule 28 'rolesin', 1, undef ], [#Rule 29 'rolesin', 1, undef ], [#Rule 30 'rolesout', 0, undef ], [#Rule 31 'rolesout', 1, undef ], [#Rule 32 'rolesout', 1, undef ], [#Rule 33 'rolesep', 1, undef ], [#Rule 34 'rolesep', 1, undef ], [#Rule 35 'roles', 1, undef ], [#Rule 36 'roles', 3, sub #line 187 "yapp/astma2-fact.yp" { push @{$_[1]->[0]}, @{$_[3]->[0]}; push @{$_[1]->[1]}, @{$_[3]->[1]}; $_[1]; } ], [#Rule 37 '@6-1', 0, sub #line 194 "yapp/astma2-fact.yp" { $_[0]->{USER}->{role} = $_[0]->{USER}->{ctx}->[0] } ], [#Rule 38 '@7-3', 0, sub #line 195 "yapp/astma2-fact.yp" { $_[0]->{USER}->{ctx}->[0] = undef } ], [#Rule 39 'role', 5, sub #line 196 "yapp/astma2-fact.yp" { [ [ ($_[0]->{USER}->{role}) x scalar @{$_[5]} ], $_[5] ] } ], [#Rule 40 '@8-1', 0, sub #line 201 "yapp/astma2-fact.yp" { $_[0]->{USER}->{ctx}->[0] = undef } ], [#Rule 41 'identifications', 2, sub #line 202 "yapp/astma2-fact.yp" { [ $_[1] ] } ], [#Rule 42 '@9-2', 0, sub #line 203 "yapp/astma2-fact.yp" { $_[0]->{USER}->{ctx}->[0] = undef } ], [#Rule 43 'identifications', 3, sub #line 204 "yapp/astma2-fact.yp" { push @{$_[1]}, $_[2]; $_[1]; } ], [#Rule 44 'attachments', 0, undef ], [#Rule 45 'attachments', 3, undef ], [#Rule 46 'attachments', 4, undef ], [#Rule 47 'attachments', 2, undef ], [#Rule 48 'attachments', 3, undef ], [#Rule 49 'attachments', 2, undef ], [#Rule 50 'attachments', 3, undef ], [#Rule 51 'relative', 0, undef ], [#Rule 52 'relative', 3, undef ], [#Rule 53 'upcomma', 0, undef ], [#Rule 54 'upcomma', 1, undef ], [#Rule 55 'predefined_inlines', 1, sub #line 224 "yapp/astma2-fact.yp" { 'isa' } ], [#Rule 56 'predefined_inlines', 1, sub #line 225 "yapp/astma2-fact.yp" { 'subclasses' } ], [#Rule 57 'predefined_inlines', 1, undef ], [#Rule 58 '@10-2', 0, sub #line 229 "yapp/astma2-fact.yp" { unshift @{$_[0]->{USER}->{ctx}}, undef; } ], [#Rule 59 '@11-4', 0, sub #line 230 "yapp/astma2-fact.yp" { # warn " expand ctx ".Dumper $_[0]->{USER}->{ctx}; my $left = $_[0]->{USER}->{ctx}->[1]; my $ted = $_[1]; my $right = $_[0]->{USER}->{ctx}->[0]; my $store = $_[0]->{USER}->{store}; my $params = $_[2]; #warn "left $left ted $ted right $right"; if ($ted eq 'subclasses') { $store->assert ([ undef, # LID undef, # SCOPE 'is-subclass-of', # TYPE TM->ASSOC, # KIND [ 'subclass', 'superclass' ], # ROLES [ $left, $right ], # PLAYERS undef ] ); } elsif ($ted eq 'isa') { $store->assert ([ undef, # LID undef, # SCOPE 'isa', # TYPE TM->ASSOC, # KIND [ 'instance', 'class' ], # ROLES [ $left, $right ], # PLAYERS undef ] ); } elsif ($ted eq 'hasa') { # same, but other way round $store->assert ([ undef, # LID undef, # SCOPE 'isa', # TYPE TM->ASSOC, # KIND [ 'instance', 'class' ], # ROLES [ $right, $left ], # PLAYERS undef ] ); } else { $_[0]->YYData->{INPUT} .= "\n" . _expand_template ($store, $ted, { %$params, '_left' => $left, '_right' => $right}) # compute the expanded version . "\n"; # extend the text at the end; } } ], [#Rule 60 'expansion', 6, sub #line 275 "yapp/astma2-fact.yp" { shift @{$_[0]->{USER}->{ctx}}; } ], [#Rule 61 'identification', 1, sub #line 278 "yapp/astma2-fact.yp" { # warn "tid: >>".$_[1]."<<"; if (! defined $_[1]) { # wildcard $_[0]->{USER}->{ctx}->[0] ||= $_[0]->{USER}->{store}->internalize (sprintf "uuid-%010d", $TM::toplet_ctr++); } elsif (ref ($_[1])) { # reference means indicator $_[0]->{USER}->{ctx}->[0] = $_[0]->{USER}->{store}->internalize ($_[0]->{USER}->{ctx}->[0] => $_[1]); } elsif ($_[1] =~ /^\w+:.+/) { # URI means subject address $_[0]->{USER}->{ctx}->[0] = $_[0]->{USER}->{store}->internalize ($_[0]->{USER}->{ctx}->[0] => $_[1]); } else { # some lousy identifier # warn "checking for context ".Dumper $_[0]->{USER}->{ctx}->[0] ; die "duplicate ID: $_[1] and $_[0]->{USER}->{ctx}->[0]" if ($_[0]->{USER}->{ctx}->[0]); # we already have an identifier! $_[0]->{USER}->{ctx}->[0] = $_[0]->{USER}->{store}->internalize ($_[1]); } $_[1] = $_[0]->{USER}->{ctx}->[0]; # whatever that was, that's it } ], [#Rule 62 '@12-4', 0, sub #line 296 "yapp/astma2-fact.yp" { $_[0]->{USER}->{value} = 1 } ], [#Rule 63 'characteristic', 6, sub #line 297 "yapp/astma2-fact.yp" { my $ctype = $_[1]; my $cclass; # we do not yet know what this will be if ($_[3]) { # there is a type specified $cclass = $_[3]; # take this to be the class of what ctype is } elsif ($_[1] =~ /.*name$/) { # looks like a name if ($_[6]->[1] eq XSD_STRING) { # but we check first what type the value is $cclass = 'name'; # for a string we allow it to be a name } else { $cclass = 'occurrence'; # otherwise, we guess it is an occurrence } } else { # type does not end with 'name' $cclass = 'occurrence'; # this is then an occurrence } if ($cclass ne $ctype) { # a new instance was introduced $store->assert ([ undef, # LID undef, # SCOPE 'is-subclass-of', # TYPE TM->ASSOC, # KIND [ 'subclass', 'superclass' ], # ROLES [ $ctype, $cclass ], # PLAYERS undef ] ); } # warn "char $_[1] ctx ".Dumper $_[0]->{USER}->{ctx}; $_[0]->{USER}->{store}->assert ( # [ undef, # LID $_[2], # SCOPE (undef is ok) $_[1], # TYPE $cclass eq 'name' ? TM->NAME : ($cclass eq 'occurrence' ? TM->OCC : TM->ASSOC), # KIND [ 'thing', 'value' ], # ROLES [ $_[0]->{USER}->{ctx}->[0], $_[6] ], # PLAYERS undef ] ); } ], [#Rule 64 'scope', 0, undef ], [#Rule 65 'scope', 2, sub #line 341 "yapp/astma2-fact.yp" { $_[2]; } ], [#Rule 66 'type', 0, undef ], [#Rule 67 'type', 2, sub #line 345 "yapp/astma2-fact.yp" { $_[2] } ], [#Rule 68 'tid', 1, sub #line 353 "yapp/astma2-fact.yp" { $_[1]; } ], [#Rule 69 'tid', 1, sub #line 354 "yapp/astma2-fact.yp" { undef; } ], [#Rule 70 'tid', 1, sub #line 355 "yapp/astma2-fact.yp" { \ $_[1]; } ], [#Rule 71 'tid', 2, sub #line 356 "yapp/astma2-fact.yp" { $_[2]; } ], [#Rule 72 'tid', 2, sub #line 357 "yapp/astma2-fact.yp" { \ $_[2]; } ], [#Rule 73 'tid', 1, sub #line 358 "yapp/astma2-fact.yp" { my $baseuri = $_[0]->{USER}->{store}->baseuri; $_[1] =~ /^$baseuri(.+)/ ? $1 : \ $_[1]; } ] ], %options); $self->{USER}->{store} = $store; return bless $self, $class; } #line 690 "yapp/astma2-fact.yp" sub _Error { die "Syntax error: Found ".$_[0]->YYCurtok." but expected ".join (' or ', $_[0]->YYExpect); } sub _Lexer { my $parser = shift; my $refINPUT = \$parser->YYData->{INPUT}; # study $$refINPUT; $$refINPUT or return ('', undef); # this is the end of the world, as we know it $$refINPUT =~ s/^[ \t]+//o; #warn "lexer ($parser->{USER}->{string}):>>>".$parser->YYData->{INPUT}; $$refINPUT =~ s/^\n\n//so and return ('DOT', undef); $$refINPUT =~ s/^\n$//so and return ('DOT', undef); $$refINPUT =~ s/^\.//so and return ('DOT', undef); $$refINPUT =~ s/^\~//so and return ('TILDE', undef); $$refINPUT =~ s/^=//o and return ('EQUAL', undef); $$refINPUT =~ s/^://o and return ('COLON', undef); $$refINPUT =~ s/^,\s*(which|who)\b//o and return ('DOWNCOMMA', undef); $$refINPUT =~ s/^,(?!\s*(which|who)\b)//o and return ('COMMA', undef); $$refINPUT =~ s/^is-?a\b//o and return ('ISA', undef); # $$refINPUT =~ s/^has-?a\b//o and return ('TED', 'hasa'); $$refINPUT =~ s/^subclasses\b//o and return ('SUBCL', undef); $$refINPUT =~ s/^has\b//o and return ('HAS', undef); unless ($parser->{USER}->{assoc}) { # in topic context this corresponds to HAS $$refINPUT =~ s/^\n\s*(?=\w+\s*[:<@]\s)//so and return ('HAS', undef); # positive look-ahead for things like bn : } $$refINPUT =~ s/^(which|who)\b//o and return ('WHICH', undef); $$refINPUT =~ s/^and(\s+(which|who))?\b//so and return ('WHICH', undef); # (can go over lines) $$refINPUT =~ s/^\n//so and return ('EOL', undef); $$refINPUT =~ s/^{//so and return ('BRA', undef); $$refINPUT =~ s/^}//so and return ('KET', undef); $$refINPUT =~ s/^\(//so and return ('LPAREN', undef); $$refINPUT =~ s/^\)//so and return ('RPAREN', undef); $$refINPUT =~ s/^<>//o and return ('ISREIFIED', undef); $$refINPUT =~ s/^\*//o and return ('WILDCARD', undef); $$refINPUT =~ s/^(\d{4}-\d{1,2}-\d{1,2})(T(\d{1,2}):(\d{2}))?//o and return ('DATE', sprintf "urn:x-date:%s:%02d:%02d", $1, $3 || 0, $4 || 0); # is a date $$refINPUT =~ s/^bn\b//o and return ('ID', "name"); $$refINPUT =~ s/^oc\b//o and return ('ID', "occurrence"); $$refINPUT =~ s/^in\b//o and return ('ID', "occurrence"); if ($parser->{USER}->{value}) { # parser said we should expect a value now ##warn "expect value >>".$$refINPUT."<<"; $$refINPUT =~ s/^\"{3}(.*?)\"{3}(?=\n)//so and # (warn "returning multi $1" or 1) and (undef $parser->{USER}->{value} or return ('VALUE', new TM::Literal ($1))); $$refINPUT =~ s/^\"(.*?)\"(^^(\S+))?//o and # (warn "returning simlg $1" or 1) and (undef $parser->{USER}->{value} or return ('VALUE', new TM::Literal ($1, $3))); $$refINPUT =~ s/^(\d+\.\d+)//o and # (warn "returning float $1" or 1) and (undef $parser->{USER}->{value} or return ('VALUE', new TM::Literal ($1, TM::Literal->DECIMAL))); $$refINPUT =~ s/^(\d+)//o and # (warn "returning int $1" or 1) and (undef $parser->{USER}->{value} or return ('VALUE', new TM::Literal ($1, TM::Literal->INTEGER))); $$refINPUT =~ s/^(\w+:\S+)//o and # (warn "returning uri $1" or 1) and (undef $parser->{USER}->{value} or return ('VALUE', new TM::Literal ($1, TM::Literal->URI))); $$refINPUT =~ s/^(.+?)(?=\s*\n)//o and # (warn "returning unquo $1" or 1) and (undef $parser->{USER}->{value} or return ('VALUE', new TM::Literal ($1))); ## (warn "returning $1" or 1) and ## (undef $parser->{USER}->{value} or return ('VALUE', new TM::Literal ($1))); ##warn "no string"; } ## unfortunately, this does not what I want: ## $$refINPUT =~ s/^([A-Za-z][A-Za-z0-9_-]*)(?!:)//o and return ('ID', $1); # negative look-ahead ## tricky optimization: don't ask my $aux; # need this to store identifier/uri prefix temporarily (optimization) my $aux2; # need this to store ontology URL, if there is one $$refINPUT =~ s/^([A-Za-z][.A-Za-z0-9_-]*)//o and $aux = $1 # save this for later and $$refINPUT !~ /^:[\w\/]/ and return (_is_template ($parser->{USER}->{store}, $aux) ? 'TED' : 'ID', $aux); $$refINPUT =~ s/^(:([^\s\)\(\]\[]+))//o and return ('URI', ( $aux2 = _is_ontology ($parser->{USER}->{store}, $parser->{USER}->{prefixes}, $aux)) ? $aux2."#$2" : $aux.$1); # is a URL/URN actually $$refINPUT =~ s/^@//so and return ('AT', undef); $$refINPUT =~ s/^%include\s+(.*?)(?=\n)//so and return ('INCLUDE', $1); # positive look-ahead $$refINPUT =~ s/^%log\s+(.*?)(?=\n)//so and return ('LOG', $1); # positive look-ahead $$refINPUT =~ s/^%cancel(?=\n)//so and return ('CANCEL', $1); # positive look-ahead $$refINPUT =~ s/^%version\s+(\d+\.\d+)(?=\n)//so and return ('VERSION', $1); # positive look-ahead $$refINPUT =~ s/^%encoding\s+(.*?)(?=\n)//so and return ('ENCODING', $1); # positive look-ahead # $$refINPUT =~ s/^\[//so and return ('LBRACKET', undef); # $$refINPUT =~ s/^\]//so and return ('RBRACKET', undef); $$refINPUT =~ s/^(.)//so and return ($1, $1); # should not be an issue except on error } sub _is_template { my $store = shift; my $id = shift; my $t = $store->tids ($id) or return undef; return $store->is_a ($t, $store->tids (\ TEMPLATE)); } sub _is_ontology { my $store = shift; my $prefixes = shift; my $prefix = shift; #warn "texting prefix '$prefix' on ".Dumper $prefixes; return $prefixes->{$prefix} if $prefixes->{$prefix}; # cache if ($prefix eq 'astma') { # this is one predefined prefix $prefixes->{$prefix} = ASTMA; } elsif ($prefix eq 'xsd') { # this is the other predefined prefix $prefixes->{$prefix} = XSD; } else { my $p = $store->tids ($prefix); if ($p && $store->is_a ($p, $store->tids (\ ONTOLOGY))) { # is the topic an instance of astma:ontology? $prefixes->{$prefix} = $store->toplet ($store->tids ($prefix))->[TM->INDICATORS]->[0] # then take its subject indicator as expanded URI or die "no subject indicator for '$prefix' provided"; # if there is none, complain } } #warn "prefixes now".Dumper $prefixes; return $prefixes->{$prefix}; } sub parse { my $self = shift; $self->YYData->{INPUT} = shift; #warn "parse"; $self->YYData->{INPUT} =~ s/\r/\n/sg; $self->YYData->{INPUT} =~ s/(?YYData->{INPUT} =~ s/ \+{3} /\n/g; # replace _+++_ with \n $self->YYData->{INPUT} =~ s/\+{4}/+++/g; # stuffed ++++ cleanout $self->YYData->{INPUT} =~ s/^\#.*?\n/\n/mg; # # at there start of every line -> gone $self->YYData->{INPUT} =~ s/\s+\#.*?\n/\n/mg; # anything which starts with #, all blanks are ignored $self->YYData->{INPUT} =~ s/\n\n\n+/\n\n/sg; $self->YYData->{INPUT} =~ s/\n\s+\n+/\n\n/sg; # trimm lines with blanks only # we not only capture what is said EXPLICITELY in the map, we also collect implicit knowledge # we could add this immediately into the map at parsing, but it would slow the process down and # it would probably duplicate/complicate things $self->{USER}->{implicits} = { 'isa-thing' => undef, # just let them spring into existence 'isa-scope' => undef, # just let them spring into existence 'subclasses' => undef }; # $self->{USER}->{topic_count} = 0; # $self->{USER}->{templates} = new TM (psis => undef, baseuri => $self->{USER}->{store}->baseuri); $self->{USER}->{prefixes} = {}; eval { $self->YYParse ( yylex => \&_Lexer, yyerror => \&_Error); #, yydebug => 0x01 ); }; if ($@ =~ /^Cancelled/) { warn $@; # de-escalate Cancelling to warning } elsif ($@) { die $@; # otherwise re-raise the exception } #warn "in parse end ".Dumper $self->{USER}->{implicits}; { # resolving implicit stuff my $implicits = $self->{USER}->{implicits}; my $store = $self->{USER}->{store}; { # all super/subclasses foreach my $superclass (keys %{$implicits->{'subclasses'}}) { $store->assert ( map { [ undef, undef, 'is-subclass-of', TM->ASSOC, [ 'superclass', 'subclass' ], [ $superclass, $_ ] ] } keys %{$implicits->{'subclasses'}->{$superclass}}); } } { # all things in isa-things are THINGS, simply add them $store->internalize (map { $_ => undef } keys %{$implicits->{'isa-thing'}}); } { # establishing the scoping topics $store->assert (map { [ undef, undef, 'isa', TM->ASSOC, [ 'class', 'instance' ], [ 'scope', $_ ] ] } keys %{$implicits->{'isa-scope'}}); } $store->externalize ( $store->instances ($store->tids (\ TEMPLATE)) ); # "removing templates now"; } return $self->{USER}->{store}; } #my $f = new TM::AsTMa::Fact; #$f->Run; 1;