upchuck: a chuck preprocessor

29 Nov 2007

      Since I do a lot of OO-ish stuff in ChucK and tend to reuse my standard 
classes a lot, the lack of an import mechanism or preprocessor was 
getting on my nerves.  I hacked up a (not-entirely-so-) quick one last 
night in Perl.

The only preprocessor command supported at this point is "include".  The 
syntax is:

#include(Something.ck)

or, to make things prettier:

#include(Something)

It will automatically search the current working directory, check to see 
if appending a ".ck" helps, and then do the same for every directory in 
the colon separated $CHUCK_DIRS. 

Extra credit is that it:

- Checks to avoid double includes, recursive includes, etc.
- Automatically passes all non-file arguments on to ChucK
- Translates error messages back to the original files (rather than the 
temp file that ChucK actually executes; this was a pain since ChucK uses 
stderr for output and errors)

So, let's play with it a little.  I've attached a couple of small files 
to be put in ~/ChucK.  I've got upchuck in ~/bin, which is in my path.

Then from the shell:

export CHUCK_DIRS=~/ChucK
upchuck Quux

"Foo" : (string)
"Bar" : (string)
"Baz" : (string)

This won't work on Windows, but I suspect the only thing that needs to 
be reimplemented is the tempName subroutine (which you could just write 
in Perl in about 2 minutes -- I just don't know what the standard temp 
dir is on Windows).

-Scott

#!/usr/bin/perl

use strict;
use IPC::Open3;
use Cwd 'abs_path';
use File::Basename;

################################################################################
# addOutputLine
################################################################################

our @lineMap;
our @fileMap;

sub addOutputLine
{
  my $file = shift(@_);
  my $line = shift(@_);

  push(@lineMap, $line);
  push(@fileMap, $file);
}

################################################################################
# tempName
################################################################################

sub tempName
{
  my $temp = `mktemp -t chuck.XXXXX`;
  chomp($temp);
  return $temp;
}

################################################################################
# findFile
################################################################################

sub findFile
{
  my $file = shift(@_);

  (-e $file) && return $file;
  (-e "$file.ck") && return "$file.ck";

  my @dirs = split(":", $ENV{"CHUCK_DIRS"});

  foreach my $dir (@dirs)
  {
    (-e "$dir/$file") && return "$dir/$file";
    (-e "$dir/$file.ck") && return "$dir/$file.ck";
  }

  return "";
}

################################################################################
# include
################################################################################

sub include
{
  our %includes;

  my $file = shift(@_);
  my $found = findFile($file);

  if(length($found) == 0)
  {
    die "Could not include \"$file\"";
  }

  $file = $found;

  if(++$includes{$file} > 1)
  {
    return "";
  }

  my $output;

  open(INCLUDE, $file);

  my @lines = <INCLUDE>;

  close(INCLUDE);

  my $count = 1;

  foreach my $line (@lines)
  {
    $output .= &preprocessor($line);
    addOutputLine($file, $count++);
  }

  return $output . "\n";
}

################################################################################
# preprocessor
################################################################################

sub preprocessor
{
  my $input = shift(@_);

  if($input !~ /^\s*#/)
  {
    return $input;
  }

  chomp($input);

  my $command = $input;
  my $argument = $input;

  $command =~ s/^\s*#(\w+).*/$1/;
  $argument =~ s/.*\((.+)\).*/$1/;

  if($command =~ /include/i)
  {
    return include($argument);
  }

  die "Unhandled preprocess command, \"$input\"";
}

################################################################################
# errorAdjuster
################################################################################

sub errorAdjustor
{
  my $temp = shift(@_);
  my $error = shift(@_);

  if($error =~ /^\[$temp\]:line/)
  {
    chomp($error);

    my $lineNumber = $error;

    $lineNumber =~ s/\[$temp\]:line\(([0-9]+)\).*/$1/;

    $error =~ s/$temp/$fileMap[$lineNumber - 1]/;
    $error =~ s/line\($lineNumber\)/line($lineMap[$lineNumber - 1])/;

    return "$error\n";
  }

  return $error;
}

################################################################################
# main
################################################################################

my $temp = tempName();

open(OUTPUT, ">$temp");

my $command = "chuck";

while(my $arg = shift(@ARGV))
{
  if(!findFile($arg))
  {
    $command .= " $arg";
  }
  else
  {
    print OUTPUT include($arg);
  }
}

close(OUTPUT);

$command .= " $temp";

if(fork() == 0)
{
  sleep(1);
  unlink($temp);
}
else
{
  local(*WRITE, *READ, *ERROR);

  my $pid = open3(\*WRITE, \*READ, \*ERROR, $command);

  if(fork() == 0)
  {
    my $file = basename($temp);

    while(my $line = <ERROR>)
    {
      print errorAdjustor($file, $line);
    }
  }
  else
  {
    while(my $line = <READ>)
    {
      print $line;
    }
  }

  waitpid($pid, 0);
  wait();
}

wait();

#include(Foo)
<<< "Bar" >>>;

#include(Foo)
#include(Bar)
#include(Baz)

#include(Bar)
<<< "Baz" >>>;

<<< "Foo" >>>;

Scott Wheeler

tags

participants (1)