picrin/tools/mkloader.pl

#!/usr/bin/perl

use strict;
use File::Basename qw/basename dirname/;

print <<EOL;
/**
 *                                !!NOTICE!!
 * This file was automatically generated by mkloader.pl, and includes all of
 * the prelude files required by Picrin. PLEASE DO NOT EDIT THIS FILE, changes
 * will be overwritten the next time the script runs.
 */

#include "picrin.h"
#include "picrin/extra.h"

void
pic_eval_native(pic_state *pic, const char *str)
{
  pic_value port = pic_fmemopen(pic, str, strlen(str), "r"), e;

  pic_try {
    size_t ai = pic_enter(pic);

    while (1) {
      pic_value form = pic_funcall(pic, "read", 1, port);
      if (pic_eof_p(pic, form))
        break;
      pic_funcall(pic, "eval", 1, form);
      pic_leave(pic, ai);
    }
  }
  pic_catch (e) {
    pic_fclose(pic, port);
    pic_raise(pic, e);
  }
  pic_fclose(pic, port);
}

EOL

foreach my $file (@ARGV) {
    my $var = &escape_v($file);
    print "static const char ${var}[][80] = {\n";

    open IN, $file;
    local $/ = undef;
    my $src = <IN>;
    close IN;

    my @lines = $src =~ /.{0,80}/gs;
    foreach (@lines) {
        s/\\/\\\\/g;
        s/"/\\"/g;
        s/\n/\\n/g;
        print "\"$_\",\n";
    }
    print "};\n\n";
}

print <<EOL;
void
pic_load_piclib(pic_state *pic)
{
  pic_value e;

EOL

foreach my $file (@ARGV) {
    print <<EOL;
  pic_try {
EOL
    my $var = &escape_v($file);
    my $basename = basename($file);
    my $dirname = basename(dirname($file));
    print "    pic_eval_native(pic, &${var}[0][0]);\n";
    print<<EOL
  }
  pic_catch(e) {
    /* error! */
    pic_fputs(pic, "fatal error: failure in loading $dirname/$basename\\n", pic_stderr(pic));
    pic_raise(pic, e);
  }
EOL
}

print <<EOL;
}
EOL

sub escape_v {
    ($_) = @_;
    s/\.scm$//g;
    s/[^[A-Za-z0-9_]/_/g;
    "piclib_src_" . $_;
}