#! /usr/bin/perl

# Created by Tangle on Sat Jul 10 16:54:38 1999
# Do Not Modify!


	print "This is tangle, version 2.0.0\n";
	
        
sub thistoken { return $tokenlist[$tokencount] }
sub gettoken  { skiptoken(); return lasttoken() }
sub lasttoken  { return $tokenlist[$tokencount-1] }
sub nexttoken  { return $tokenlist[$tokencount+1] }
sub skiptoken  { $howmany=1 unless defined ($howmany=shift) ; $tokencount+=$howmany ; }
sub moretokens { return ($tokencount<=$#tokenlist);}


sub lookahead {
        $howmany = shift;
        $ret="";
        for ($i=$tokencount ; $i < $tokencount+$howmany; $i++)
                { $ret.=$tokenlist[$i] ;}
        return $ret;
}


sub gimme {
        $expectation = shift;
        $whywefinished="EOF";
        $temp_name="";
        while (moretokens()) {
                $temp_name.=gettoken();		
                if (substr($temp_name,-length($expectation)) eq $expectation) {
                        $whywefinished="FOUND";
                        last
                }
        }
        return ($whywefinished, $temp_name);
}


sub careful_skip {
        $howmuch = 1 unless defined($howmuch = shift);
	if (moretokens()) {
		return if $howmuch<1;
		skiptoken();
	} else {
                
        (($changing==0)?$sourcelineno:$changelineno)++;
        $finished=1 if ($sourcelineno > $#source);
        $changeable=0 if ($changelineno > $#change);
        print STDERR "." if ($sourcelineno%100)==0;
        print STDERR $sourcelineno if ($sourcelineno%500)==0;



		if ($phase == 1 ) {
			
$changeline=$change[$changelineno];
$sourceline=$source[$sourcelineno];
if ($changeable==0) {
        $_=$sourceline;
} else {
        if ($changing==0) {
                if ($changeline eq $sourceline) {
                        
$savesourcelineno=$sourcelineno;
$savechangelineno=$changelineno;
$checking=1;
while ($checking==1) {
        $sourceline=$source[$sourcelineno];
        $changeline=$change[$changelineno];
        if ($changeline =~ /\@y/) {
                                $changing=1;
                $checking=0;
        } elsif ($changeline ne $sourceline) {
                print STDERR "! Change failed to match!\n The change begun at line ".$savechangelineno." of the change file\n failed to match at line $sourcelineno of the source file.\nI'll ignore this change altogether.\n";
                $checking=$changing=0;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $savechangelineno=$changelineno;         } elsif ($sourcelineno>$#source) {
                print STDERR "! Ran out of source code.\n Your change begun at line ".$savechangelineno." matched too well,\n and I've got nothing left to process.\nIgnoring that change.\n";
                $checking=$changing=0;
                $changelineno=$savechangelineno+1;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $savechangelineno=$changelineno;
        } elsif ($changelineno>$#change or $changeline =~ /\@z/ ) {
                print STDERR "! Where is the matching \@y?\n Change begun at line ".$savechangelineno." didn't appear to have a \@y, so I'm ignoring it.\n";
                $checking=$changing=0;
                $changelineno=$savechangelineno+1;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $savechangelineno=$changelineno;
        }
        $changelineno++;
        $sourcelineno++;
}


                        if ($changing==1) {
                                
        if ($change[$changelineno]=~/\@z/) {
                $changing=0;
                $changelineno++;
                $sourcelineno--;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $_=$source[$sourcelineno];
        } else { $_=$change[$changelineno]; }


                        }
                } else {$_=$sourceline;}
        } else {
                
        if ($change[$changelineno]=~/\@z/) {
                $changing=0;
                $changelineno++;
                $sourcelineno--;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $_=$source[$sourcelineno];
        } else { $_=$change[$changelineno]; }


        }
}


			@merged[$newsourceline++]=$_ if $merging; 		} else {
			$_=$merged[$lineno++];
		}
                
@tokenlist=split /(?<=[^a-zA-Z0-9_])|(?=[^a-zA-Z0-9_])/o;
$tokencount=0;
@tokenlist=crushtokens(@tokenlist);


        }
        careful_skip(--$howmuch) if $howmuch>0;
}


sub careful_gimme {
	
	$delimiter = "@>" unless defined($delimiter = shift);
	($status, $rv) = gimme($delimiter);
        if ($status eq "EOF") {
                while ($status eq "EOF" and $finished==0) {
                        careful_skip(0);                         ($status, $newrv)=gimme($delimiter);
			$rv.=$newrv;
			
                }
        }
        return($rv);
} 



        
sub cname {
$tryname=shift;
$tryname=~s/(.*)\.\.\./\1/;
$tryname=tidyname($tryname);
$lastone="";
foreach (sort @cs_names) {
        $thisone=substr(tidyname($_),0,length($tryname));
        if (lc $tryname eq lc $lastone ) {
                if ($thisone eq $lastone) {
                   print "! Module name confusion.\n";
                   print "I came across a reference to a module called $tryname... ";
                   print " and this could refer to either ~".$_."~ or ~".$fulllast."~\n";
                   die "This is a rather serious problem, but I\'ll try and work around it.\n";
                   return "";
	
                }
                return $fulllast;                                                                          }
        if (lc $tryname gt lc $lastone and lc $tryname lt lc $thisone) {                                           print "! Module name not found.\n\n";
                print "I came across a reference to a module called $tryname...\n";
                print "The closest I got was that it's somewhere between\n$fulllast and\n$_. \n";
		print "I can't decide which to go for, so I'm giving up.\n\n"; print "I'd suggest that in future you gave me some more characters \nto identify th at one uniquely.\n";
		die;
                return "";
        }
        $fulllast=$_;                                                                                      
        $lastone=$thisone;
}

return $fulllast
}


        
sub tidyname{
        $tidyname=shift;
        $tidyname=~s/^\s*(.*)\s*$/\1/;
        $tidyname=~s/\s+/ /g;
        return $tidyname;
}



	local @tokenlist, $tokencount;
	$|=1;
	$changing=$finished=0;
	$maxdepth=25;
	
chomp($input=shift);
if (!open(INPUT, $input) and !open(INPUT, $input.".web" )) {
        do {
                print "! I can't find file `$input'\n\nPlease type another input file name: ";
                chomp($input=<>);
        } until (open(INPUT,$input));
}
@source=<INPUT>;
chomp($changefile=shift);
if ($changefile eq "") {
        $inputbase=$input;
        $inputbase=~s/\.web$//;
        if (-e $inputbase.".ch") {
                print "! Change file exists, but you've not told me to use it.\nI'll trust you know what you're doing.\n";
        }
        $changeable=0;
} else {
        if (!open(CHANGE, $changefile) and !open(CHANGE, $changefile.".ch" )) {
                do {
                        print "! I can't find file `$input'\n\nPlease type another input file name: ";
                        chomp($changefile=<>);
                } until (open(CHANGE,$changefile));
        }
        @change=<CHANGE>;
        $changeable=1;
}
$changelineno=$sourcelineno=0; 

	
	print $input." (";




$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


local $newsourceline=0;
@merged=();
$merging=1;
$phase=1;
$state="skipping";
$program="";
open LOG,">t.log";
while ($finished==0) {
        
$changeline=$change[$changelineno];
$sourceline=$source[$sourcelineno];
if ($changeable==0) {
        $_=$sourceline;
} else {
        if ($changing==0) {
                if ($changeline eq $sourceline) {
                        
$savesourcelineno=$sourcelineno;
$savechangelineno=$changelineno;
$checking=1;
while ($checking==1) {
        $sourceline=$source[$sourcelineno];
        $changeline=$change[$changelineno];
        if ($changeline =~ /\@y/) {
                                $changing=1;
                $checking=0;
        } elsif ($changeline ne $sourceline) {
                print STDERR "! Change failed to match!\n The change begun at line ".$savechangelineno." of the change file\n failed to match at line $sourcelineno of the source file.\nI'll ignore this change altogether.\n";
                $checking=$changing=0;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $savechangelineno=$changelineno;         } elsif ($sourcelineno>$#source) {
                print STDERR "! Ran out of source code.\n Your change begun at line ".$savechangelineno." matched too well,\n and I've got nothing left to process.\nIgnoring that change.\n";
                $checking=$changing=0;
                $changelineno=$savechangelineno+1;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $savechangelineno=$changelineno;
        } elsif ($changelineno>$#change or $changeline =~ /\@z/ ) {
                print STDERR "! Where is the matching \@y?\n Change begun at line ".$savechangelineno." didn't appear to have a \@y, so I'm ignoring it.\n";
                $checking=$changing=0;
                $changelineno=$savechangelineno+1;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $savechangelineno=$changelineno;
        }
        $changelineno++;
        $sourcelineno++;
}


                        if ($changing==1) {
                                
        if ($change[$changelineno]=~/\@z/) {
                $changing=0;
                $changelineno++;
                $sourcelineno--;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $_=$source[$sourcelineno];
        } else { $_=$change[$changelineno]; }


                        }
                } else {$_=$sourceline;}
        } else {
                
        if ($change[$changelineno]=~/\@z/) {
                $changing=0;
                $changelineno++;
                $sourcelineno--;
                
$priming=1;
while ($priming==1) {
        $changeline=$change[$changelineno];
        if ($changeline=~ /\@w/) {
		$_=$changeline;
                


        } elsif ($changeline=~ /\@y/ or $changeline=~/\@z/) {
                $errorfile="change";
                $errortoken=-1;
                print STDERR "! Where is the matching \@x?\n";
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print STDERR "\n\nI found either an \@y or a \@z that didn't appear to\nfollow an \@x, so I'm going to ignore everything I see\n until the next \@x.\n\n";
        }
        if ($changeline=~ /\@x/) {
                $priming=0;         }
        $changelineno++;         if ($changelineno>$#change) {
                                $priming=0;
                $changeable=0;
        }

}


                $_=$source[$sourcelineno];
        } else { $_=$change[$changelineno]; }


        }
}


        @merged[$newsourceline++]=$_;
        
@tokenlist=split /(?<=[^a-zA-Z0-9_])|(?=[^a-zA-Z0-9_])/o;
$tokencount=0;
@tokenlist=crushtokens(@tokenlist);


        while (moretokens()) {
		print LOG thistoken();
		if ($state eq "skipping") {
			
	$thistoken=thistoken(); 	if ($thistoken eq "@"."p") { 
		skiptoken();
		$state="creating";
	} elsif ($thistoken eq "@"."<") {
		

$current_cs="";
skiptoken();
$current_cs = substr(careful_gimme("@".">"),0,-2);
$current_cs =tidyname($current_cs);
if ($current_cs=~ /\.\.\.\s*$/) {
	$current_cs=cname($current_cs);
}


else {
	push(@cs_names, $current_cs) unless (scalar grep(/\Q$current_cs\E/, @cs_names) > 0);
}

careful_skip() if (thistoken() eq "+");
if(thistoken() eq "=") {
	$state="defining";
} else {
	
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


	print "! This shouldn't be here.\n\n";
	print "You tried to reference a code section in ";
	print "documentation state.\nYou can't do that, so ";
	print "I'm ignoring it.\n";
}


		skiptoken();
	} elsif ($thistoken eq "@"."d") {
		
	skiptoken();
	1 while (($lhs = gettoken())=~/\s/);
        while (($type=gettoken())=~/\s/) {}
	# print "*D* LHS $lhs type $type : token ".thistoken()." lasttoken ".lasttoken()."\n";
        if ($type eq "(") {
                
	
$template=$lhs."(";
$params=careful_gimme(")");
if ($params =~ /[^0-9#,)]/) {
	print "! Parametric macro template broken.\n";
	print "The template for $lsh should only contain";
	print "hashs, numbers and commas.\n";
}
$template.=$params;


	1 while (gettoken()=~/\s/);
	skiptoken(-1);
	unless (thistoken() eq "==") {
		print "\n! No equals sign in parametric macro!\n";	
		print "You said $template,\n";
		print "but didn't provide two equals signs.\n";
	} else {
		careful_skip();
		careful_skip() while (thistoken()=~/\s/);
		
$rhs=specialcareful_gimme();
$rhs=~s/\s*$//s;
skiptoken(-1);


		


	}
	
$macros{$lhs."/par"}=[$template, $rhs];


	

        } elsif ($type eq "=") {
		
        1 while (gettoken()=~/\s/);
	skiptoken(-1);
	
$rhs=specialcareful_gimme();
$rhs=~s/\s*$//s;
skiptoken(-1);


	$macros{$lhs."/num"}=$rhs;


	} elsif ($type eq "==") {
                
        1 while (gettoken()=~/\s/);
	skiptoken(-1);
	
$rhs=specialcareful_gimme();
$rhs=~s/\s*$//s;
skiptoken(-1);


	$macros{$lhs."/sim"}=$rhs;


        } else {
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print "! That's no macro definition!\n";
                print "You said $lhs $type, which makes no sense. Not to me, anyway.\n";
        }


		$state="skipping";
	} elsif ($type eq "1") {
		$debug=1;
		skiptoken();
	} elsif ($type eq "2") {
		$debug=2;
		skiptoken();
	} else {
		skiptoken();
	}


		} elsif ($state eq "defining" or $state eq "creating") {
			
if (thistoken() =~/@/) {
        
$type=substr(thistoken(),1,1);
if ($type eq "@" or $type eq "<" or $type eq ">") {
	($state eq "defining"?$code{$current_cs}:$program).=thistoken();
		skiptoken();
} elsif ($type eq "{" or $type eq ":" or $type eq "."
	or $type eq "!" or $type eq "?" or $type eq "t") {
	careful_gimme($type eq "{"?"@}":"@>");
	skiptoken();
} elsif ($type eq "f" or $type eq " " or $type eq "*") {
	$state="skipping";
} elsif ($type eq "d") {
	
	skiptoken();
	1 while (($lhs = gettoken())=~/\s/);
        while (($type=gettoken())=~/\s/) {}
	# print "*D* LHS $lhs type $type : token ".thistoken()." lasttoken ".lasttoken()."\n";
        if ($type eq "(") {
                
	
$template=$lhs."(";
$params=careful_gimme(")");
if ($params =~ /[^0-9#,)]/) {
	print "! Parametric macro template broken.\n";
	print "The template for $lsh should only contain";
	print "hashs, numbers and commas.\n";
}
$template.=$params;


	1 while (gettoken()=~/\s/);
	skiptoken(-1);
	unless (thistoken() eq "==") {
		print "\n! No equals sign in parametric macro!\n";	
		print "You said $template,\n";
		print "but didn't provide two equals signs.\n";
	} else {
		careful_skip();
		careful_skip() while (thistoken()=~/\s/);
		
$rhs=specialcareful_gimme();
$rhs=~s/\s*$//s;
skiptoken(-1);


		


	}
	
$macros{$lhs."/par"}=[$template, $rhs];


	

        } elsif ($type eq "=") {
		
        1 while (gettoken()=~/\s/);
	skiptoken(-1);
	
$rhs=specialcareful_gimme();
$rhs=~s/\s*$//s;
skiptoken(-1);


	$macros{$lhs."/num"}=$rhs;


	} elsif ($type eq "==") {
                
        1 while (gettoken()=~/\s/);
	skiptoken(-1);
	
$rhs=specialcareful_gimme();
$rhs=~s/\s*$//s;
skiptoken(-1);


	$macros{$lhs."/sim"}=$rhs;


        } else {
                
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


                print "! That's no macro definition!\n";
                print "You said $lhs $type, which makes no sense. Not to me, anyway.\n";
        }


} elsif ($type eq "p") {
	if ($state eq "creating") {
		
	print "! Already creating!\n";
	print "You tried to start an unnamed code section, while ";
	print "I was in the\nmiddle of one. This means your code may";
	print "not be correct.\nI'm going to carry on anyway.\n";
	skiptoken();


	} else {
		$state="creating";
		skiptoken();
	}
} elsif ($type eq "'" or $type eq "\"") {
	
	skiptoken();
        ($state eq "defining"?$code{$current_cs}:$program).=
		($type eq "'"?oct(gettoken()):hex(gettoken()));


} elsif ($type eq "&") {
	skiptoken();
} elsif ($type eq "1") {
	$debug=1;
} elsif ($type eq "2") {
	$debug=2;
} else {
	
print STDERR 1+(($errorfile eq "change")?$changelineno:$sourcelineno),". ";
$errortoken = $tokencount unless defined $errortoken; if ($errortoken == -1) {         if ($errorfile eq "change") {
                $errorline=$change[$changelineno];
        } else { $errorline=$source[$sourcelineno]; }
} else {
	$errortoken=$tokencount if undef $errortoken;
        $errorline="";
        for (0..$errortoken) { $errorline.=$tokenlist[$_]; }
        $errorline.= "||";
        for ($errortoken+1 .. $#tokenlist) { $errorline.=$tokenlist[$_];}
}
undef $errortoken;
print STDERR $errorline;


	print "! I don't understand this command sequence: ";
	print thistoken()."\n";
	skiptoken();
}
   

} else {
        ($state eq "defining"?$code{$current_cs}:$program).=thistoken();
        skiptoken();
}


		} else {
			print "! This can't happen.\n\n";
			die "I'm in state $state, which is impossible.\n";
		}
        }
        
        (($changing==0)?$sourcelineno:$changelineno)++;
        $finished=1 if ($sourcelineno > $#source);
        $changeable=0 if ($changelineno > $#change);
        print STDERR "." if ($sourcelineno%100)==0;
        print STDERR $sourcelineno if ($sourcelineno%500)==0;



}



print ")\nOutput (";


$output=$input;
$output=~ s/(.*)\..*/\1/;
$stack=$output;
$output.=".pl";

 until (open(OUTPUT, ">$output")) {
        print "! I can't write on $output\n\n Please type another file name: ";
        chomp($output=<>);
}



print OUTPUT "#! ".`which perl`."\n";
print OUTPUT "# Created by Tangle on ".scalar localtime;
print OUTPUT "\n# Do Not Modify!\n";
print OUTPUT expand($program,"root");
`chmod +x $output`;





print ")\n\n";
close OUTPUT;
`chmod +x $output` unless $^O =~/Win/i;




sub crushtokens {
my @res;
my $el1, $el2;
while (@_) {
        ($first, $second) = (shift, shift);
        if ($first eq "@" or ($first eq "=" and $second eq "="))
          { push(@res, $first.$second) }
        else
          { push(@res, $first);

            if ($second eq "@" or $second eq "=") {
                unshift @_, $second;
            } else { push (@res, $second); }
        }
}
return @res;
}


sub expand {
local($returnee) = "";
local($text,$tree)=(shift, shift);
local(@tokenlist);
local($tokencount)=0;
$_=$text;

@tokenlist=split /(?<=[^a-zA-Z0-9_])|(?=[^a-zA-Z0-9_])/o;
$tokencount=0;
@tokenlist=crushtokens(@tokenlist);


while (moretokens()) {
	$this=thistoken();
	if (is_macro($this)) {
		{ local $_=$this;
		
$depth=0 unless defined $depth;
if ($depth++>$maxdepth) {
	print "! Macro recursion count exceeded!\n";
	print "More than $maxdepth iterations.\n";
	print "Last macro expanded was $_\n";
	die "Probably a source code error.\n";
}
if ( ($mt=macro_type($_)) eq "num" ) {
	$expansion= expand_num($_); } elsif ( $mt eq "par" ) {
	
$macro=$macname=$_;
$fail=0;
@parlist=();
{local $result='';
skiptoken() if $macro eq thistoken();
if (thistoken() ne '(') {
	print "\n! No ( found\n";
	print "Parametric macros should start with a open bracket\n";
	print "I found ".thistoken()."\n";
	$result .= $_.thistoken();
} else {
	
$finished=0;
$curr_arg="";
$_=gettoken();
until ($finished) { 
	$_=gettoken();
	if (/\(/) {
		print "Bracket opened.\n";
		$bracecount=1;
		$curr_arg.=$_;
		until ($bracecount==0) {
			$_=gettoken();
			$curr_arg.=$_;
			$bracecount-- if /\)/;
			$bracecount++ if /\(/;
			
	if (!moretokens()) {
		print "\n! Macro use never ended!\n";
		print "$tokencount, $#tokenlist\n";
		print "You started using $macname, but didn't ";
		print "close the brackets.\n";
		die "What happened?";
		$fail=1;
		last;
	}


		}		
		print "current argument is $curr_arg.\n";
		print "Bracket closed.\n";
	} elsif (/\)/) {
		$finished=1;
		push @parlist, $curr_arg;
		last;
	} elsif (/,/) {
		push @parlist, $curr_arg;
		$curr_arg="";
	} else {
		$curr_arg.=$_;
	}
	
	if (!moretokens()) {
		print "\n! Macro use never ended!\n";
		print "$tokencount, $#tokenlist\n";
		print "You started using $macname, but didn't ";
		print "close the brackets.\n";
		die "What happened?";
		$fail=1;
		last;
	}


}


	if ($fail) {
		$result .= $macro;
	} else { 
		$parexp = expand_par($macname,@parlist);
		$result.=$parexp;
	}
}
$expansion=$result;
}


} elsif ( $mt eq "sim" ) {
	$expansion=expand_sim($_);

} else {
	die "! Can't happen. (macros)\n";
}
$depth--;


		$returnee.=$expansion;
		}
		skiptoken();
	} elsif (thistoken() =~/^@/) {
		
$type=substr(thistoken(),1,1);
if ($type eq "@") {
	$returnee.="@";
	skiptoken();
} elsif ($type eq "<") {
	

$current_cs="";
skiptoken();
$current_cs = substr(careful_gimme("@".">"),0,-2);
$current_cs =tidyname($current_cs);
if ($current_cs=~ /\.\.\.\s*$/) {
	$current_cs=cname($current_cs);
}

	
if (exists $code{$current_cs}) {
	if ($tree=~/:\Q$current_cs\E/) {
		print "\n! Recursive calling not allowed!\n";
		print "Calling $current_cs\nnow will put me";
		print " into an infinite loop, so I'm skipping it\n";
	} else {
		print ".";
		$returnee.=expand($code{$current_cs},$tree.":".$current_cs);
	}
} else {
	print "\n! Unknown Module\nI collected a reference to\n";
	print $current_cs.", which does not exist.\n";
} 


} else {
	print "\n! Couldn't grok $type command in output phase.\n";
	skiptoken();
} 


	} else {
		$returnee.=gettoken();
	}
}
return $returnee;
}



sub macro_type { $this = shift;
	if ( exists $macros{$this."/num"} ) {
		return "num";
	} elsif ( exists $macros{$this."/sim"} ) {
		return "sim";
	} elsif ( exists $macros{$this."/par"} ) {
		return "par";
	} else { return -1 }
}

sub is_macro { $this = shift; return macro_type($this) != -1 }



sub expand_num  { 
local $result ="\$returnvalue = ";
$_=$macros{shift()."/num"};

@tokenlist=split /(?<=[^a-zA-Z0-9_])|(?=[^a-zA-Z0-9_])/o;
$tokencount=0;
@tokenlist=crushtokens(@tokenlist);


while ($_=gettoken()) {
	if ( is_macro($_) ) {
		undef $expansion;
		
$depth=0 unless defined $depth;
if ($depth++>$maxdepth) {
	print "! Macro recursion count exceeded!\n";
	print "More than $maxdepth iterations.\n";
	print "Last macro expanded was $_\n";
	die "Probably a source code error.\n";
}
if ( ($mt=macro_type($_)) eq "num" ) {
	$expansion= expand_num($_); } elsif ( $mt eq "par" ) {
	
$macro=$macname=$_;
$fail=0;
@parlist=();
{local $result='';
skiptoken() if $macro eq thistoken();
if (thistoken() ne '(') {
	print "\n! No ( found\n";
	print "Parametric macros should start with a open bracket\n";
	print "I found ".thistoken()."\n";
	$result .= $_.thistoken();
} else {
	
$finished=0;
$curr_arg="";
$_=gettoken();
until ($finished) { 
	$_=gettoken();
	if (/\(/) {
		print "Bracket opened.\n";
		$bracecount=1;
		$curr_arg.=$_;
		until ($bracecount==0) {
			$_=gettoken();
			$curr_arg.=$_;
			$bracecount-- if /\)/;
			$bracecount++ if /\(/;
			
	if (!moretokens()) {
		print "\n! Macro use never ended!\n";
		print "$tokencount, $#tokenlist\n";
		print "You started using $macname, but didn't ";
		print "close the brackets.\n";
		die "What happened?";
		$fail=1;
		last;
	}


		}		
		print "current argument is $curr_arg.\n";
		print "Bracket closed.\n";
	} elsif (/\)/) {
		$finished=1;
		push @parlist, $curr_arg;
		last;
	} elsif (/,/) {
		push @parlist, $curr_arg;
		$curr_arg="";
	} else {
		$curr_arg.=$_;
	}
	
	if (!moretokens()) {
		print "\n! Macro use never ended!\n";
		print "$tokencount, $#tokenlist\n";
		print "You started using $macname, but didn't ";
		print "close the brackets.\n";
		die "What happened?";
		$fail=1;
		last;
	}


}


	if ($fail) {
		$result .= $macro;
	} else { 
		$parexp = expand_par($macname,@parlist);
		$result.=$parexp;
	}
}
$expansion=$result;
}


} elsif ( $mt eq "sim" ) {
	$expansion=expand_sim($_);

} else {
	die "! Can't happen. (macros)\n";
}
$depth--;


		$result.="(".$expansion.")";
	} elsif ( /[0-9\(\)\+\-\/\*\^\s]/) { $result .= $_ }
	else { print "\n! Illegal Character in Numeric Macro!\n";
		print "You can't say ($_) in a numeric macro; I'm ";
		print "skipping it.\n";
	}	
}

eval $result ; if ($@) { 
	print "! Macro definition fried.\n";
	print "Something went wrong evaluating your macro.\n";
	print "I'm afraid I don't know why. I'm skipping it.\n";
	return;
}
return $returnvalue;
}


sub expand_sim { return $macros{shift()."/sim"} }



sub expand_par {
	($template,$replacement)=@{$macros{($macname=shift)."/par"}};
	local $result="";
	@arguments=@_;
	
	if ($#arguments != scalar grep /,/,$template) {
		print "\nUse of $macname doesn't match its definition\n";
		print "You need ".(1+(scalar grep /,/,$template));
		print " arguments, not ".(1+$#arguments)."\n";
		print "Who knows what happens at this point?\n";
		return "";
	}


	$counter=0; 
	foreach(@arguments) {
		$counter++;
		$replacement=~s/#$counter/$_/g;
	}
	
@toksave=@tokenlist; $tcsave=$tokencount; # local is broken.
{ 
	local $output='';
	local $_=$replacement;
	local @tokenlist, $tokencount;
	
@tokenlist=split /(?<=[^a-zA-Z0-9_])|(?=[^a-zA-Z0-9_])/o;
$tokencount=0;
@tokenlist=crushtokens(@tokenlist);


	while (moretokens()) {
		$_=gettoken();
		if (is_macro($_)) {
			undef $expansion;
			
$depth=0 unless defined $depth;
if ($depth++>$maxdepth) {
	print "! Macro recursion count exceeded!\n";
	print "More than $maxdepth iterations.\n";
	print "Last macro expanded was $_\n";
	die "Probably a source code error.\n";
}
if ( ($mt=macro_type($_)) eq "num" ) {
	$expansion= expand_num($_); } elsif ( $mt eq "par" ) {
	
$macro=$macname=$_;
$fail=0;
@parlist=();
{local $result='';
skiptoken() if $macro eq thistoken();
if (thistoken() ne '(') {
	print "\n! No ( found\n";
	print "Parametric macros should start with a open bracket\n";
	print "I found ".thistoken()."\n";
	$result .= $_.thistoken();
} else {
	
$finished=0;
$curr_arg="";
$_=gettoken();
until ($finished) { 
	$_=gettoken();
	if (/\(/) {
		print "Bracket opened.\n";
		$bracecount=1;
		$curr_arg.=$_;
		until ($bracecount==0) {
			$_=gettoken();
			$curr_arg.=$_;
			$bracecount-- if /\)/;
			$bracecount++ if /\(/;
			
	if (!moretokens()) {
		print "\n! Macro use never ended!\n";
		print "$tokencount, $#tokenlist\n";
		print "You started using $macname, but didn't ";
		print "close the brackets.\n";
		die "What happened?";
		$fail=1;
		last;
	}


		}		
		print "current argument is $curr_arg.\n";
		print "Bracket closed.\n";
	} elsif (/\)/) {
		$finished=1;
		push @parlist, $curr_arg;
		last;
	} elsif (/,/) {
		push @parlist, $curr_arg;
		$curr_arg="";
	} else {
		$curr_arg.=$_;
	}
	
	if (!moretokens()) {
		print "\n! Macro use never ended!\n";
		print "$tokencount, $#tokenlist\n";
		print "You started using $macname, but didn't ";
		print "close the brackets.\n";
		die "What happened?";
		$fail=1;
		last;
	}


}


	if ($fail) {
		$result .= $macro;
	} else { 
		$parexp = expand_par($macname,@parlist);
		$result.=$parexp;
	}
}
$expansion=$result;
}


} elsif ( $mt eq "sim" ) {
	$expansion=expand_sim($_);

} else {
	die "! Can't happen. (macros)\n";
}
$depth--;

 
			$result.=$expansion;
		} else { $result .= $_ }
	}
}
@tokenlist=@toksave; $tokencount=$tcsave; # local is broken.
skiptoken(-1);


	return $result;
}


sub specialgimme {
        $return='';
        $whywefinished="EOF";
        while (moretokens()) {
                $thisone=gettoken();
                if ($thisone =~ /@/ and $thisone ne "@@") {
                        $whywefinished="FOUND";
                        last
                } else  {
                        $return.=$thisone;
                }
        }
        return ($whywefinished,$return);
}

sub specialcareful_gimme {
        ($status, $rv) = specialgimme();
        if ($status eq "EOF") {
                while ($status eq "EOF" and $finished==0) {
                        careful_skip(0);                         ($status, $newrv)=specialgimme();
                        $rv.=$newrv;
                }
        }
        return($rv);
}