package xm::pfe::expandxrefwordrefsfcode;
use strict;
use xm::o;
use xm::sub;

sub DESC
{"
  get all ITEMFCODEs, make a database with the key to the contained
  <FORTHHEADER>..<XDEF>key</XDEF>. Then get to the remainings
  being a flattened wordset-table and expand XREFWORDREF with
  the ITEMFCODE. That's it.
  see xm::pfe::fcodesortnspill and xm::pfe::flattenwordrefs
"}

sub per_ITEMWORDREF
{
    my ($ann,$in,$end,$definfo) = @_;
    
    my $xrefwordref = ""; my $xrefword = "";
    $in =~ s{ (<XREFWORDREF(?:\s[^<>]*)?>) ((?:.(?!</XREFWORDREF[\s>]))*.) 
                  (</XREFWORDREF(?:\s[^<>]*)?>) }
    { $xrefwordref .= $1.$2.$3; $xrefword = $2; $1.$2.$3 }gsex;

    my $typewordref = ""; my $typeword = "";
    $in =~ s{ (<TYPEWORDREF(?:\s[^<>]*)?>) ((?:.(?!</TYPEWORDREF[\s>]))*.) 
                  (</TYPEWORDREF(?:\s[^<>]*)?>) }
    { $typewordref .= $1.$2.$3; $typeword = $2; $1.$2.$3 }gsex;

    my $cstrwordref = ""; my $cstrword = "";
    $in =~ s{ (<CSTRWORDREF(?:\s[^<>]*)?>) ((?:.(?!</CSTRWORDREF[\s>]))*.) 
                  (</CSTRWORDREF?(?:\s[^<>]*)?>) }
    { $cstrwordref .= $1.$2.$3; $cstrword = $2; $1.$2.$3 }gsex;

    my $linkwordref = ""; my $linkword = "";
    $in =~ s{ (<LINKWORDREF(?:\s[^<>]*)?>) ((?:.(?!</LINKWORDREF[\s>]))*.) 
                  (</LINKWORDREF(?:\s[^<>]*)?>) }
    { $linkwordref .= $1.$2.$3; $linkword= $2; $1.$2.$3 }gsex;

    my $typewordcoded = ""; my $typecoded = "";
    $in =~ s{ (<TYPEWORDCODED(?:\s[^<>]*)?>) ((?:.(?!</TYPEWORDCODED[\s>]))*.) 
                  (</TYPEWORDCODED(?:\s[^<>]*)?>) }
    { $typewordcoded .= $1.$2.$3; $typecoded = $2; $1.$2.$3 }gsex;

    if ($typecoded =~ /synonym/)
    {
	my $word = $linkword;
	$word =~ s{<[^<>]*>}{}g;
	$$definfo{$xrefword} =
	    "[] this word is a ".$typecoded." of <XREF>".$word."</XREF>.";
    }elsif ($typecoded =~ /obsolete/)
    {
	my $word = $linkword;
	$word =~ s{<[^<>]*>}{}g;
	my $deff = $cstrwordref;
	$deff =~ s{<[^<>]*>}{}g;
	$$definfo{$xrefword} =
	    "[] this word is a ".$typecoded.". "
	    ."\n<br> please use the new word <XREF>".$word."</XREF>."
	    ."\n<br> the obsolete word <XREF>".$deff."</XREF> will be removed"
	    ." in the next generation.";
    }elsif ($typecoded =~ /exception/)
    {
	$$definfo{$xrefword} =
	    "[] this word maps the exception string to a specific internal "
	    ."\n predefined number, it is not visible on the forth "
	    ."\n commandline in the terminal. When an exception uses the "
	    ."\n value of <code>".$linkword."</code> it will be shown to "
	    ."\n the user as ".$cstrword.".";
    }elsif ($typecoded =~ /offsetval/)
    {
	$$definfo{$xrefword} =
	    "[] this word specifies an offset helper word. "
	    ."\n the most common use of such words includes "
	    ."\n an address and this word will add the offset "
	    ."\n to get to a specific substructure. This ".$typecoded
	    ."\n was defined through <code>".$linkword."</code> .";
    }elsif ($typecoded =~ /threadstate/)
    {
	$$definfo{$xrefword} =
	    "[] this word allows access to a forth internal value"
	    ."\n which is not part of the forth dictionary but of"
	    ."\n the threading state. Here it is a ".$typecoded 
	    ."\n which allows access to <code>TH-&gt;".$linkword."</code>.";
    }elsif ($typecoded =~ /constant/)
    {
	$$definfo{$xrefword} =
	    "[] this word is a ".$typecoded." that expands to "
	    ."\n <code>".$linkword."</code>.";
    }elsif ($typecoded =~ /variable|valuevar/)
    {
	$$definfo{$xrefword} =
	    "[] this word is a ".$typecoded." of forth.";
    }elsif ($typecoded =~ /primitive/)
    {
	my $word = $linkword;
	$word =~ s{<[^<>]*>}{}g;
	$$definfo{$xrefword} =
	    "[] this word is a ".$typecoded." calling the internal C-routine "
	    ."<XREF>".$word."</XREF>_ (within the forth machine).";
    }elsif (length $typecoded > 5)
    {
	$$definfo{$xrefword} =
	    "[] this word is a ".$typecoded." used to compile into"
	    ."\n the dictionary ".$linkword;
    }

#    if (exists $$definfo{$xrefword})
#    {
#	my $F = "tmp.definfo.xml";
#	if (open F, ">>$F")
#	{
#	    print F "<DEFINFO><XREFWORDREF>$xrefword</XREFWORDREF>",
#	    $$definfo{$xrefword}, "</DEFINFO>\n";
#	    close F;
#	}
#    }

    return $ann.$in.$end;
}


sub getxdef 
{
    my $in = shift;
    if ($in =~ m{ <FORTHHEADER>
		      ((?:.(?!</?FORTHHEADER[\s>]))*.) 
			  <XDEF>
			      ((?:.(?!</?XDEF[\s>]))*.) 
				  </XDEF> 
				  }sx) 
    { return $2; }
    return "";
}	


sub DO
{
    my $in = shift;
    my $xdef;
    my $item; # hashref;
    my $out;

    # pass 1 : cut out all ITEMFCODEs and store them by their XDEF

    $in =~ s{ (<ITEMFCODE(?:\s[^<>]*)?>) 
		  ((?:.(?!</?ITEMFCODE[\s>]))*.) (</ITEMFCODE(?:\s[^<>]*)?>)
		  }
    { 
	$out = $1.$2.$3;
	$xdef = getxdef ($2);
	if (length $xdef)
	{
	    $out =~  s{ <XDEF> ((?:.(?!</?XDEF[\s>]))*.)  </XDEF> }
	    { "<XREFWORDREF>".$1."</XREFWORDREF>" }gsex;
	    $$item{$xdef} = $out;
	};
	""
    }gsex;

    # pass 2 : check the default info for each item
    my %definfo;
    $in =~ s{ (<ITEMWORDREF(?:\s[^<>]*)?>) ((?:.(?!</ITEMWORDREF[\s>]))*.)
		  (</ITEMWORDREF(?:\s[^<>]*)?>) }
    {
	per_ITEMWORDREF ($1,$2,$3,\%definfo);
    }gsex;

#    {
#	my $F = "tmp.definfo2.xml";
#	if (open F, ">>$F")
#	{
#	    my $v; for $v (keys %definfo)  {
#		print F "<DEFINFO><XREFWORDREF>$v</XREFWORDREF>",
#		$definfo{$v}, "</DEFINFO>\n";
#	    }  close F;
#	}
#    }

    # pass 3 : look for XREFWORDREF and push the text in there.
    
    $in =~ s{ (<XREFWORDREF(?:\s[^<>]*)?>) 
		  ((?:.(?!</?XREFWORDREF[\s>]))*.) 
		  (</XREFWORDREF(?:\s[^<>]*)?>) }
    { 
	my ($ann,$body,$end) = ( $1, $2, $3 );
	my $tail = $body; $tail =~ s/.*\s//;
	exists $$item{$body} ? $$item{$body} 
	: exists $$item{$tail} ? $$item{$tail} 
	: exists $definfo{$body} 
	? $ann.$body.$end
	    ."<XREFWORDREFINFO>".$definfo{$body}."</XREFWORDREFINFO>"
	: $ann.$body.$end
	    ."<XREFWORDREFINFO> [] no special info,"
	    ." see general notes </XREFWORDREFINFO>"
    }gsex;

    return $in;
}

sub ARGS { return    xm::o::args_stdin(@_,DESC); }
sub main { return DO(xm::o::args_stdin(@_,DESC)); }


1;