#!/usr/bin/perl

# Copyright Oscar Campbell, 2000. Started 2K-February-20th something.
# Se PROJECT.txt för detaljerad onödig progress info...


$VERSION = "0.6 (001010)";

$WELCOMESTRING = "\ncython version $VERSION (\"Less Dumb Version\") by Oscar Campbell.\n\n";


$maintabwd = 8;
$force = 0; # force compile? (även om .c[pp] är uptodate..)
$removetempfile = 1;
$pretty = 0; # generate 'pretty' c/c++ code...
$translate = 1; # translate compiler output... 0 = no, 1 = auto (because it won't work on win..), 2 = yes, force.. (will still not work on win.. ;)
$maindebugouts = 1;
$stopAtErrors = 1;


if (-e "project.y") {
	$project = 1;
}

if (scalar(@ARGV) == 0) {
	if (!$project) {
		print $WELCOMESTRING;
	        &printusage;
	}
}


#process arguments...
sub processArgs () {
	foreach $a (@_) { #@ARGV) {
		if ($a =~ /^-f(orce)?/) {
			$force = 1;
		} elsif ($a =~ /^-t(ab)?=(\d*)/) {
			$maintabwd = $2;
		} elsif ($a =~ /^-pr(etty)?/) {
			$pretty = 1;
		} elsif ($a =~ /^-p(roject)?/) {
			print $WELCOMESTRING;
			$project = 0;
			if (-e "project.y") {
				$project = 1;
			} else {
				die "You passed the \"compile project\" flag, yet there is no project.y file!\n";
			}
		} elsif ($a =~ /^-tr(anslate)?(=[01])?/) {
			if ($2 eq "=0") {
				$translate = 0;
			} elsif ($2 eq "=1" || $2 eq "") {
				$translate = 2;
			}
		} elsif ($a =~ /^-k(eepfiles)?/) {
			$removetempfile = 0;
		
		} elsif ($a =~ /^-de(bug)?(=[01])?/) {
			if ($2 eq "=1" || $2 eq "") {
				$maindebugouts = 1;
			} elsif ($2 eq "=0") {
				$maindebugouts = 0;
			}
		} elsif ($a =~ /^-d(ontStopAtErrors)?/) {
			$stopAtErrors = 0;
		
		} elsif ($a =~ /^-(-)?h(elp)?/) {
			&printusage();
			die "";
		} elsif ($a =~ /^-(-)?v(ersion)?/) {
			die "Cytoc version " . $VERSION . "\n\n";
		} else {
			$fname = $a;
		}
	}
}



&processArgs(@ARGV);

######## Om det är ett project:

# inget project:
if (!$project) {
	$tabwd = $maintabwd; # vi har maintabwd sparad för att varje fil kan komma att ändra tabwd och då återställer vi här ifrån..
	&compilefile($fname);
} else {
# project:	
	open PR, "<project.y" or die "project.y not found? Or not accessible?\n";
	my @lines = <PR>; #läser in project..
	close PR;
	my $lines = join("", @lines);
	@lines = "";

	$_ = $lines;
	s/\\[ \t]*\n//gm; # joina rader..

	#if (s/^#tab[= ](\d*).*$//gm) {
	#	$maintabwd = $1;
	#}
	s/^[ \t]*$//gm;	 # ta bort tomma rader innan project-compile loopen..
	s/^\n//gm;		  # ta bort ännu tommare rader...

	@lines = split(/\n/);
	undef $lines;
	
	my @files;
	foreach $line (@lines) {
		$_ = $line;
	
		if (/^#[ \t]/) {
			@a = split(/ /, $line);
			&processArgs(@a);
                        undef @a;
			&processArgs(@ARGV); # commandline skall alltid ha övertaget...

		#if (/^#k(eepfiles)?/) {
		#	$removetempfile = 0;
		#} elsif (/^#debug[ \t=]*o[nf]{1,2}$/) {
		#	if ($1 eq "n") {
		#		$debugouts = 1;
		#	} else {
		#		$debugouts = 0;
		#	}
		} elsif (/^c(ompiler)?:[\t ]*(.*)$/) {
			if ($cc) {
				die "Error in \"project.y\" file! 'compiler:' without 'files:' list?\n";
			}
			$cc = $2;
			$error = 0;

		} elsif (/^f(iles)?:[ \t]*(.*)$/) {
			@files = split (/[ \t]+/, $2);
			if ($files[0] eq "\*") {
				@files = "";

			# gör globbing...
			}

			COMPFILES: foreach $fil (@files) {
				if (!(-e $fil)) {
					print "Filen $fil från project.y hittades inte!\n\n";
					next;
				}
				$cyh = 0;
				if ($fil =~ /\.cyh$/) {
					$cyh = 1;
				}
				if (&compilefile($fil) && !$cyh && $cc) {
					$fil =~ s/(.*)\.cy(p?)$/$1\.c$2$2/; #cy ->c, cyp -> cpp
					my $tfil = $fil;
					$tfil =~ s/\..*/\.o/; # för -c -o bla.o bla.c .. .
					my $tmpcc = $cc;
					$tmpcc =~ s/%f/$fil/; #%f till fil.c[pp]
					$tmpcc =~ s/%o/$tfil/; #%o till fil.o
					print "Sending to compiler like this: $tmpcc\n";
					#system ($tmpcc) == 0
					#or print "Compiler not found?\n";	# kör kompilator strängen som står i project filen med filnamnet insatt..
#					@ccout = `$tmpcc`; # 2>&1`;
					if ($translate) {
						@ccout = `$tmpcc 2>&1`;

						foreach $ccout (@ccout) {
							if ($ccout =~ s/^(.*)\.(cp?)(p?):/$1.cy$3:/) {   # översätt c/cpp till cy/cyp, alla andra far över som de är..
								if ($pretty) {
									$ccout =~ s/:(\d*):/:$transrow[$1]:/;
								}
							}
							print ">> " . $ccout;
						}
						undef @ccout;
					} else {
						`$tmpcc`;
					}
					
					# note att </> är omvänd mot i compilefile()... eftersom den filen touch'ats, men inte den andran nu..
					if (((stat($fil))[9] > (stat($tfil))[9])) { # om object ej updatead så måste det ha blivit nåt ball, right?
						$error = 1;
						if ($stopAtErrors) {
							last COMPFILES;
						}
					}

					if ($removetempfile) {
						unlink($fil);
					}
					print "\n";
				}
			}
			$cc = ""; # kompilering klar av alla files, töm $cc så den kan 'laddas om' för nästa files: list.. (om någon mer..)
			$lnkf .= " " . join(" ", @files);
			undef @files;
			
		# Dags att länka?
		} elsif (/^l(inker)?(c?):[\t ]*(.*)$/) {
			if ($error) {
				last;
			}

			$lnk = $3;
			if ($2 eq "c") {
				$obj = 0;
			} else {
				$obj = 1;
			}

			if ($lnk && !$cyh) {
				if ($obj) {
					$lnkf =~ s/\.[^ \n]*/\.o/gm; # ersätt .*vadsomhelst med .o (ex. .c, .cpp, .s till .o) #### .c, .cpp med .o  ##c(pp)?
				}

				$lnk =~ s/%[fo]/$lnkf/; # sätt in filerna att länka...
				print "Sending to linker like this: $lnk\n";
				$error = system ($lnk);  # kör kompilator strängen som står i project filen med filnamnet insatt..

				print "\n";
				undef $lnkf;
			}
		} elsif (/^r(un)?:[\t ]*(.*)$/) {
			if (error) {
				last;
			}
			# *TODO*
			# if (!$error) {
			# blabla run...
			# $error = "";
			# }

		} else {
			if (!(/^[ \t]*\/\//)) { # om inte en kommentar...
				die "Unrecognised command in project.y file: \"$_\"\n";
			}
		}

		#	{
		#		die "No 'files:' list found in project file, add 'files: *' to automatically compile alla files in dir.\n";
		#	}

	} # while rader i project...
}	

print "\n\n\n";
# e-o-program.. nedan är bara sub routines..







########################################
# Det är här parsing actionen är... Själva translatorn..
########################################
sub compilefile  #arg 1 = file..
{
	my $lineofs = 0;#1; # från array 'rad' 0 till editor rad 1

	my $fname = $_[0];
	my $outname = $_[0];
	if ($outname !~ s/(.*)\.cy(p?)$/$1\.c$2$2/) { # cy -> c, cyp -> cpp, cyh -> h ... (cy, cyp, cyh?)
		$outname =~ s/(.*)\.cyh$/$1\.h/;
	}

	if ($outname eq $fname) {
		print "   No need to preprocess. Not an cython .cy or .cyh file.\n";
		return 1;
	}

	my $outnam = $outname;
#	if ($removetempfile) {
		$outnam =~ s/\.\w*$/\.o/;
#	}
	if (((stat($fname))[9] < (stat($outnam))[9]) && !$force) {
		#print "$outnam is uptodate. No compile needed. Override with -force\n\n";
		return 0;
	}
        undef $outnam;
	
	print "   Processing $fname > $outname : ";
	

	if ($fname) {
		open XF, "<$fname" or die "\nFile $fname not found!\n\n\n";
		open OUTF, ">$outname" or die "\nCouldn't open out file!\n\n\n";
	} else {
		die "KOMMER VI NÅNSIN HIT??\n";
	}
	
	my @lines = <XF>; #läser in prog..
	close XF;

	$tabwd = $maintabwd;
	$debugouts = $maindebugouts;
	$ofsline = 0;
	
	for ($n = 0; $n<3; $n++) {
		if ($lines[$n] =~ s/^#tab[\t =]*([0-9]+).*\n/\n/) { # TODO: supporta kommentarer eol sen...
			$tabwd = $1;
			if ($pretty) {
				$lines[$n] = "";
				$ofsline = +1; # Om ofsline sätts till 1 i starten blir det fel, men inte nu, så vi låter det vara så här..
			}
		}
		if ($lines[$n] =~ s/^#debug[\t =]*(on|off).*\n/\n/) { # TODO: supporta kommentarer eol sen...
			if ($1 eq "on") {
				$debugouts = 1;
			} else {
				$debugouts = 0;
			}
			if ($pretty) {
				$lines[$n] = "";
				$ofsline += 1; # Om ofsline sätts till 1 i starten blir det fel, men inte nu, så vi låter det vara så här..
			}
		}
	}

	@intransl = "";
	my $tmpnls = "";
	for ($n = 0; $n < @lines; $n++) {
		if ($lines[$n] !~ /\/\// &&  $lines[$n] =~ s/\\[ \t]*\n[ \t]*/ /m) { # ta bort '\' i slut av rader som inte är C++ comments, samt \n efter det.. (= join)
			if ($pretty){
				$ofsline++;
			} else {
				$tmpnls .= "\n";
			}
		} else {
			if (!$pretty) {
				$lines[$n] .= $tmpnls;# . $lines[$n];
				$tmpnls = "";
			}
		}

		$intransl[$n-$ofsline +1] = $n+ 1;
######		print $n . "=" . $intransl[$n] . "\n";
	}
        undef $tmpnls;
	print " Tabwidth: $tabwd, debug = $debugouts.\n";
	
# detta kan verka o-optimerat.. Men vi måste ändå 'göra om' arrayn så de tomma raderna försvinner..
	my $lines = join("",@lines);
	$lines =~ s/^#d([ \t]*)/#define$1/gm;
	$lines =~ s/ {$tabwd}/\t/gm; # ersätt tabwd spaces med en tab..
	if ($debugouts == 0) {
		$lines =~ s/^DBG/\/\/DBG/gm;
	} else {
		$lines =~ s/^DBG//gm;
	}
		
	@lines = split(/\n/, $lines);
	undef $lines;# = "";
	foreach $l (@lines) {
		$l .= "\n";
	}
#

	my $longcomment = 0;
	my $hanging = 0;
	########################################
	# first pass, get indentvalues and expand some stuff
	########################################
# foreach är inte lämpligt här.. Vi behöver ändå $n...
	for ($n = 0; $n < @lines; $n++) {
		$_ = $lines[$n];
		
		$linesind[$n] = 0; #"de-warnifier"..

		if ($longcomment == 1) {
			if (/\*\//) { # om eof comment.. Obs, en ny kan ju sen börja på samma line.. msåte fixas sen...
				$longcomment = 0;
			}
			$linesind[$n] = -3;
			next;
		}

		if (/^[\t ]*\/\//) { # om // nånstans i början på rad..
			$linesind[$n] = -3;
		} elsif (/\/\*/) { # om /*
			if (!(/\/\*.*\*\//)) {		# om 'slutkommentar' på samma rad så skiter vi i det..
				$longcomment = 1;
			}
			if (/^[ \t]*\/\*/) {	 # om inget före /*...
				$linesind[$n] = -3;
			} else {				# nå kod före /*, så vi sätter indent...
				$linesind[$n] = &getindent($lines[$n]);
			}
		} elsif (/^[\t ]*$/) {   # tom rad
			$linesind[$n] = -3;

			# : flyttad till pass två..
			#} elsif (/^[\t ]*;[\t ]*$/) {   # bara ett ; (skall bort senare när vi har 'smart' code..
			#	   $linesind[$n] = -2;
			
			# : flyttad till efter alla elsif som egen if..
			#} elsif (/,[\t ]*$/) { # om ',' i slut av rad..
			#	   $hanging = 1; # 'hänger' kvar till nästa gång vi stöter på en icke -3 rad.. (se ovan ovan)
			
		} elsif (/^[\t ]*[{}][\t ]*$/) {   # bara en { eller en }
                        $linesind[$n] = -2;
		} elsif (/^#i /) {
			if ($lines[$n] !~ s/^#i ([^"<][^"> \n]*)(.*)$/#include "$1"$2/) {
				$lines[$n] =~ s/^#i /#include /;
			}
			#$lines[$n] .= $cmmnt; # uninitialized, hur? # ahh, well, behövs inte längre iaf...
			$linesind[$n] = -2;
		} elsif (/^#define /) {
			#	s/^#d/#define/;
			$linesind[$n] = -2;
		} elsif (/^#\w*/) {	 # om #preprocessorgrej annat en #include el. #define..
			$linesind[$n] = -2;

		} elsif (/(^\t*_DBG)/) { # en _DBG statement hittad.. klura ut alla delar..
			if ($debugouts == 0) {
				$lines[$n] =~ s/(^\t*)(.*)/$1\/\/$2/;
			} else {
				$tstr = $_;
				$_ = $tstr;
				s/^(\t*)_DBG//;
				$nln = "$1fprintf(stderr, \"";
				$exprl = "";

				$cmmnt = "";
				if (s/([ \t]*\/\/[^"]*)\n$//) {  # om det fanns nån eol comment så fångade vi den nu..
					$cmmnt = $1;#
				}

				chomp;
				while (length) {
					my $gotsome = 0;
					s/(^[^%\n]*)//;   #fånga ren text..
					if (length $1) {
						$nln .= $1;
						$gotsome = 1;
					}
					if (length == 0) { last }
					if (s/^%%//) {
						$nln .= "%";
						next;
					}
					if (s/(%\w)([^%]*)%//) {	# fånga %n varibel/expression %..
						$nln .= "$1";
						$exprl .= ", $2";
						$gotsome = 1;
					}
					if ($gotsome == 0) {
						print "ERROR!  " . ($n+$lineofs) . ": _DBG synthax error.. forgot a '%' before or after an expressionr?\n";
						last;
					}
				}
				$nln .= "\"$exprl)$cmmnt\n";
				$lines[$n] = $nln;
			}
			$linesind[$n] = &getindent($lines[$n]);
		
		} elsif (/^\t*case .*:[\t ]*/) {	# inget '$' för det skall gå att sätta in '{' efter :
			$linesind[$n] = &getindent($lines[$n]) + 1;	 # cases skall alltså ligga vert med switch för att bli rätt..
			
		#} elsif (/^\t*\w*.*:([ \t]+\w)?(\/[\*\/].*)?$/) {
		} elsif (/^\t*\w*.*:([ \t]+\w)?(\/\/.*)?$/) { #TODO: det funkar inte med comment efter label: etc..
		#} elsif (/^\t*.*:(((\/\/.*$)|(\/\*))|$)/) {
			$linesind[$n] = -2;

		} elsif ($hanging > 0) { # om ett ',' (el. '\' kanske) i slutet på last ind.sens. line så ska vi nu 'använda det'
			$linesind[$n] = $hanging; #-2;
			$hanging = 0;
		
		} else {		# en 'vanlig' rad... No special case..
			$linesind[$n] = &getindent($lines[$n]);
		}
		
		# ',' i slutet av raden check...
		if (/,[\t ]*(\/[\*\/].*)?$/) {
			#		if (/,[\t ]*(\/\*)?(\/\/)?.*$/) { # om ',' i slut av rad.. ( innan // el. /* )
			$hanging = $linesind[$n]; # 'hänger' kvar till nästa gång vi stöter på en icke -3 rad.. (se efter kommentar eslif'arna)
		}
		# '\' i slutet av raden check...
		#if (/^[^#].*\\[ \t]*$/) {
		#	### AVVIKELSE FRÅN NORMEN:
		#	# Vi tar bort '\' i slutet av raden, fast vi officiellt bara tar indents i 'pass 1'... (iofs gör vi det på fler ställen ovan)
		#	$lines[$n] =~ s/\\$//;
		#	$hanging = -3;
		#}
		
		### DBG IND		$lines[$n] = $linesind[$n] . ": " . $lines[$n];
	}


	$lines[@lines] = "";            #
	$linesind[@linesind] = "0";     # lägg till en tom entry för att sista '}' skall läggas till..

	
########################################
# second pass, insert brackets and ;'s...
########################################
	my $lind = 0;
	my $ln = 0;
	my $lastwascomma = 0;
	for ($n = 0; $n < @lines; $n++) {
		my $ind = $linesind[$n];
		if ($ind < 0) {		 # < -1	# -2 = kod etc. som inte är indent sens. -3 = wspc / comments, -1 = special, ska inte ha ; men är indent. sens.
			next;
		}
		
		###  hitta nästa indent värde som inte är < 0:
		my $nind = 0;
		for ($t = $n+1; $t < @linesind; $t++) {
			if ($linesind[$t] >= 0) {
				$nind = $linesind[$t];
				last;
			}
		}
		###
		if ($ind < $lind) {   #	|| $n == @lines) { # låser sig, varför?: || $n+1 == @lines SKIT SAMMA, lagt efter loopen...
			$t = $lind - $ind;
			if ($pretty) {
				$tstr = "";
				while ($t--) {
					$tstr .= "\t" x ($ind+$t) . "}\n";
				}
				$lines[$ln] .= $tstr; # lägger efter förra raden som hade indent värde...
			} else {
###### Här har vi gjort om:
				$tstr = "}" x $t; # . "\n";
				chomp($lines[$ln]);
				if ($lines[$ln] !~ s/([ \t]*\/\/.*)$/$tstr$1\n/) {    # sätt in { efter statements..
					$lines[$ln] .= $tstr . "\n";
				}
			}
		}
		if ($ind < $nind) {
			if (($nind - $ind) > 1) {
				if ($pretty) {
					print "WARNING! " . ($intransl[$n]+1) . ": Indentation increased by " . ($nind - $ind) . " levels.\n";
				} else {
					print "WARNING! " . ($n+1) . ": Indentation increased by " . ($nind - $ind) . " levels.\n";
				}
			}
			
			
			if ($lines[$n] =~ /\/\//) {
				$lines[$n] =~ s/([\t ]*\/\/)/ \{$1/; # sätt in { nånstans..
			} else {
				$lines[$n] =~ s/\n/ \{\n/;
			}
		} else { # if ($ind >= $nind) {
			# om public:, case: etc... vi kollar efter ett whspc efter så det inte är t.ex. par::value..
			# eller om endast ett ';' på en rad.. (ska bort senare..)
			# eller om , i slut av rad...
#### look out,, strange changes here...
			if ($lines[$n]=~/^\t*\w*.*:[ \t]*\{?(\/[\*\/].*)?$/
					  || $lines[$n]=~/^[\t ]*;[\t ]*/
					  #|| $lines[$n]=~/,[\t ]*(\/[\*\/].*)?$/) { # om ',' precis innan //, /* el [$]..
			   ) {
					  # inget semikolon sätts in...
			} elsif ($lines[$n]=~/,[\t ]*(\/[\*\/].*)?$/) { # om ',' precis innan //, /* el [$]..
				$lastwascomma = 1;
			} elsif ($lastwascomma == 1) {
				if ($lines[$n] !~ /,[\t ]*(\/[\*\/].*)?$/) { # kolla så det inte är en till komma rad.. då ska lastwascomma INTE nollställas..
					$lastwascomma = 0;
				}
			} else {
				if ($lines[$n] !~ s/([ \t]*\/[\/\*])/; $1/) {	   # sätt in ; efter statements..
					$lines[$n] =~ s/\n/;\n/;
				}
			}
		}
		
		$lind = $ind;
		$ln = $n;
	}
	
	undef @linesind;

	print OUTF @lines;
	close OUTF;
	

	############# gör radnummer översättar array... ############
	if ($pretty) {
		my $lines = join("", @lines); # Delar upp alla nya rader
		@lines = split(/\n/, $lines); # till egna array entries...
		undef $lines;
		@transrow = "";
		my $xn = 0;
		for ($n = 0; $n < @lines; $n++) {
			if ($lines[$n] !~ /\t*}[ \t]*$/) { # om inte ensam '}' på en rad..
				$xn++;
			}
			$transrow[$n] = $intransl[$xn];
	
			####		print " " . ($n+1) ."=". ($transrow[$n]+1) ."	";
		}
	}
	############################################################


	return 1;
} # sub compilefile


sub getindent
{
	$_[0] =~ /^(\t*)/;
	return length $1;
}

sub printusage
{
	print "  usage:\n";
	print "cython [-t(ab)=n] [-f(orce)] [-k(eepfile)] [-p(roject)] [-v(ersion)] [-d(ontStopAtErrors)] [-pr(etty)] [-tr(anslate)(=0|1)] [filename.cy[ph]]\n";
	die "\n";
}
