[PRL] How about Tues 200-300 for macro reading group?

Jeffrey D Palm jpalm at ccs.neu.edu
Mon Sep 13 18:21:21 EDT 2004


Matthias Felleisen wrote:

 > I got pretty sick staring at Perl, so I rewrote the program in Pretty
 > Big. It's 2 lines longer, argh. Anyone who knows more about our
 > libraries? -- Matthias

you could stare at this, it converts the (slightly modified, below) perl into java...

#!/usr/bin/perl

print <<HERE;
public class Constraints {
   public static void main(String[] args) {
HERE

while (<>) {

     chomp;

     # @days = (mon, tue, wed, thu, fri);
     if (m/days = (.*);/) {
	my $days = $1;
	my $day_strings = $days;
	$day_strings =~ s/[()]/\"/g;
	$day_strings =~ s/,/\",/g;
	$day_strings =~ s/, /, \"/g;
	println("    String[] days = {$day_strings};");
	println("    java.util.Map constraints = new java.util.HashMap();");
     }

     elsif (m/^\#(.*)/) {
	my $ln = $1;
	println("// $ln\n");
     }

     # mon => ['1200','1330' , '1330','1445' , ],
     elsif (m/(\S+)\s*=>\s*\[(.*)\]/) {
	my $day = $1;
	my $innards = $2;
	$innards =~ s/\'/\"/g;
	println("    constraints.put(\"$day\", new String[]{$innards});");
     }

     #$start_hour = 8;
     elsif (m/^\$(.*)/) {
	my $rest = $1;
	println("    int $rest");
     }

     #print "\n";
     elsif (m/print\s*(.*);/) {
	my $rest = $1;
	$rest =~ s/\./+/g;
	$rest =~ s/eq/==/;
	$rest =~ s/\: /\: \"\"+/g;
	println("  System.out.print($rest);");
     }

     #for (my $h = $start_hour; $h <= $stop_hour; $h++) {
     elsif (m/for\s*\(my(.*)/) {
	my $rest = $1;
	$rest =~ s/\#(\w+)/$1.length-1/;
	println("for (int $rest");
     }

     #    my $hour = $h < 10 ? 0 . $h : $h;
     elsif (m/my\s*(\S+)\s*=\s*\S+\s*<\s*(\d+)\s*\?\s*(\S+)\s*\.\s*(\S+)\s*\:\s*(\S+)(.*)/) {
	my $n = $1;
	my $m = $2;
	my $a = $3;
	my $b = $4;
	println("    String $n = $b < $m ? \"$a\" + $b : \"\"+$b;");
     }

     #		my $start = $cst[$j+0];
     elsif (m/my \$(.*)/) {
	my $rest = $1;
	println(($rest =~ /=\s*0/ ? "int" : "String") . " $rest");
     }

     #    my @cst = @{ $constraints{$day} };
     elsif (m/my \@(\w+) = \@{ \$(\w+){\$(\w+)/) {
	my $a = $1;
	my $b = $2;
	my $c = $3;
	#      String[] cst = (String[])constraints.get(day);
	println("   String[] $a = (String[])$b.get($c);");
     }

     # );
			      elsif (m/\);/) {
				  # nothing
			      }

     else {
	println($_);
     }
}

println("  }");
println("}");

sub println ($) {
     my $s = shift;
     if (m/\%/) {return}
     $s =~ s/\$//g;
     $s =~ s/ \. / + /g;
     $s =~ s/ eq\s*(\w+)/.equals\($1\)/;
     print "$s\n";
}

=======================================================================

#!/usr/bin/perl

@days = (mon, tue, wed, thu, fri);

# day -> constraints
# a constraints is a list of (start,stop) times
%constraints = (
#        mitch           will
  mon => ['1200','1330' , '1330','1445' , ],
#        carl, et al.    will             sam            jeff
  tue => ['1145','1705' , '1600','2345' ,  '1100','0515', '0800','1130'],
#        pl              will
  wed => ['1145','1330' , '1145','1445' , ],
#        mitch           mitch           mitch           will will            sam
  thu => ['0900','1100' , '1200','1330' , '1330','1445' , '1445','1800', '1800','2100' , '1230','1330'],
#        mitch           will            sam
  fri => ['0800','2145' , '0800','2145' , '1300','1500'],
  );

$start_hour = 8;
$stop_hour = 21;
print "Day ";
for (my $h = $start_hour; $h <= $stop_hour; $h++) {
     my $hour = $h < 10 ? 0 . $h : $h;
     print $hour . "00 ";
}
print "\n";
for (my $i = 0; $i <= $#days; $i++) {
     my $stack = 0;
     my $day = $days[$i];
     my @cst = @{ $constraints{$day} };
     print $day;
     for (my $h = $start_hour; $h <= $stop_hour; $h++) {
	my $hour = $h < 10 ? 0 . $h : $h;
	print " ";
	for (my $m = 0; $m <= 45; $m += 15) {
	    for (my $j = 0; $j <= $#cst; $j += 2) {
		my $start = $cst[$j+0];
		my $stop  = $cst[$j+1];
		my $min = $m < 10 ? 0 . $m : $m;
		my $time = $hour . $min;
		if ($time eq $start) {$stack++;}
		if ($time eq $stop)  {$stack--;}
	    }
	    print $stack == 0 ? " " : $stack;
	}
     }
     print "\n";
}


-- 
Jeffrey Palm --> http://www.ccs.neu.edu/home/jpalm



More information about the PRL mailing list