Changeset 5697

Timestamp:

07/19/05 16:28:50 (3 years ago)

Author:

iblech

svk:copy_cache_prev:

7696

Message:

* Pugs.Compile -- Added a comment explaining why the raw Exp of a PPos isn't showed.
* PIL2JS: Moved the JS part of the Prelude to libjs/PIL2JS.js.
* PIL2JS: pil2js.pl, jspugs.pl -- Sanitized options.
* PIL2JS: PIL2JS.js, Prelude::JS -- Fixed linefeeds not working correctly undef

IE, thanks to Arathorn++ and castaway++.

Files:

• perl5/PIL2JS/jspugs.pl (modified) (3 diffs)
• perl5/PIL2JS/lib6/Prelude/JS.pm (modified) (1 diff)
• perl5/PIL2JS/libjs (added)
• perl5/PIL2JS/libjs/PIL2JS.js (added)
• perl5/PIL2JS/pil2js.pl (modified) (4 diffs)
• src/Pugs/Compile.hs (modified) (1 diff)

perl5/PIL2JS/jspugs.pl

@@ -98 +98 @@
   my $pil = pugs("-I$cfg{lib6}", "-CPIL", "-MPrelude::JS", "-e", "''");
   print $OUT "Error: Couldn't compile Prelude::JS to PIL!\n" and return if not defined $pil;
-  pil2js($pil, $cfg{preludepc}, "--no-jsprelude") or
+  pil2js($pil, $cfg{preludepc}, "--jsprelude-mode=no", "--p6preludepc-mode=no") or
     print $OUT "Error: Couldn't compile Prelude::JS to JavaScript!\n";
   command_conf("preludepc");
@@ -134 +134 @@
   my $pil = pugs("-I$cfg{lib6}", "-CPIL", @_);
   print $OUT "Error: Couldn't compile to PIL!\n" and return if not defined $pil;
-  pil2js($pil, $cfg{output}, "--html", "--preludepc", $cfg{preludepc}) or
+  pil2js($pil, $cfg{output}, "--html", "--p6preludepc-path", $cfg{preludepc}) or
     print $OUT "Error: Couldn't compile to JavaScript!\n" and return;
   command_conf("output");
@@ -142 +142 @@
   my $pil = pugs("-I$cfg{lib6}", "-CPIL", "-e", $_[0]);
   print $OUT "Error: Couldn't compile to PIL!\n" and return if not defined $pil;
-  pil2js($pil, undef, "--no-jsprelude") or
+  pil2js($pil, undef, "--jsprelude-mode=no", "--p6preludepc-mode=no") or
     print $OUT "Error: Couldn't compile to JavaScript!\n" and return;
   print $OUT "\n";

perl5/PIL2JS/lib6/Prelude/JS.pm

@@ -142 +142 @@
   JS::inline('
     function (msg) {
-      // Convert "\n"s correctly (IE...)
-      var LF = typeof document != "undefined" && typeof document.all != "undefined"
-        ? "\r"
-        : "\n";
-      msg.replace(/\n/, LF);
-
       // Rest copied from
       // http://openjsan.org/doc/t/th/theory/Test/Simple/0.11/lib/Test/Builder.html.

perl5/PIL2JS/pil2js.pl

@@ -11 +11 @@
 use PIL::Nodes;
 
+local ($/, $_);
+
+sub slurp($) {
+  open my $fh, "<", $_[0] or die "Couldn't open \"$_[0]\" for reading: $!\n";
+  local $/;
+  return <$fh>;
+}
+
+sub guess_jsprelude_path {
+  my $pathsep = $^O eq "MSWin32" ? "\\" : "/";
+
+  my $path =  $INC{"PIL${pathsep}Nodes.pm"};
+  $path    =~ s[PIL${pathsep}Nodes\.pm][..${pathsep}libjs${pathsep}PIL2JS.js];
+
+  return -f $path ? $path : undef;
+}
+
+my %jsprelude = (mode => "inline", path => guess_jsprelude_path());
+my %p6prelude = (mode => "link");
+
 GetOptions(
-  "verbose"      => \my $verbose,
-  "html"         => \my $html,
-  "no-jsprelude" => \my $no_jsprelude,
-  "preludepc=s"  => \my $preludepc,
-  "yaml-dump"    => \my $yaml_dump,
-  "help"         => \&usage,
+  "verbose"            => \my $verbose,
+  "html"               => \my $html,
+  "jsprelude-mode=s"   => \$jsprelude{mode},
+  "p6preludepc-mode=s" => \$p6prelude{mode},
+  "jsprelude-path=s"   => \$jsprelude{path},
+  "p6preludepc-path=s" => \$p6prelude{path},
+  "yaml-dump"          => \my $yaml_dump,
+  "help"               => \&usage,
 ) or usage();
 
-die "Option --preludepc needs --html.\n"
-  if $preludepc and not $html;
-die <<ERR if $yaml_dump and ($html or $no_jsprelude or $preludepc);
-Option --yaml-dump only dumps the PIL parse tree as YAML and then
-exits; Terefore, it can't be used in conjunction with --html,
---no-jsprelude, or --preludepc.
+usage() unless
+  $jsprelude{mode} =~ /^(?:no|inline|link)$/ and
+  $p6prelude{mode} =~ /^(?:no|inline|link)$/;
+
+die <<ERR if not $html and ($jsprelude{mode} eq "link" or $p6prelude{mode} eq "link");
+*** Can't link to Prelude if --html option not given!
 ERR
 
-local $/;
+die <<ERR if not $p6prelude{path} and ($p6prelude{inline} or $p6prelude{link});
+*** Can't inline or link to the precompiled Prelude,
+    as no path to the Prelude was given.
+ERR
+
+die <<ERR if not $jsprelude{path} and ($jsprelude{inline} or $jsprelude{link});
+*** Can't inline or link to the JavaScript Prelude (PIL2JS.js),
+    as no path to the Prelude was given.
+ERR
+
+warn "*** Reading PIL...\n" if $verbose;
+
 my $pil  = <>;
 my $tree = PIL::Parser->parse($pil);
@@ -38 +71 @@
 }
 
-# This is the part of the JS Prelude which needs to be written in JS.
-local $_;
-my $prelude = <<'EOF';
-if(PIL2JS == undefined) var PIL2JS = {};
-
-// This is necessary to emulate pass by ref, needed for is rw and is ref.
-PIL2JS.Box = function (value) {
-  this.GET   = function ()  { return value };
-  this.STORE = function (n) { value = n.GET(); return n };
-};
-
-PIL2JS.Box.prototype = {
-  clone: function () {
-    return new PIL2JS.Box(this.GET());
-  },
-  toNative: function () {
-    var unboxed = this.GET();
-    if(unboxed instanceof Array) {
-      var arr = [];
-      for(var i = 0; i < unboxed.length; i++) {
-        arr.push(unboxed[i].toNative());
-      }
-      return arr;
-    } else if(unboxed instanceof Function) {
-      return function () {
-        var args = arguments;
-        for(var i = 0; i < args.length; i++)
-          args[i] = new PIL2JS.Box.Constant(args[i]);
-        return unboxed(args).toNative();
-      };
-    } else {
-      return unboxed;
-    }
-  },
-  perl_methods: {}
-  /*
-    toString: function () {
-      _26main_3a_3aprefix_3a_7e.GET()([this]);
-    },
-  */
-};
-
-PIL2JS.Box.ReadOnly = function (box) {
-  this.GET   = function ()  { return box.GET() };
-  this.STORE = function (n) { PIL2JS.die("Can't modify constant item!\n"); return n };
-};
-PIL2JS.Box.Constant = function (value) {
-  this.GET   = function ()  { return value };
-  this.STORE = function (n) { PIL2JS.die("Can't modify constant item!\n"); return n };
-};
-PIL2JS.Box.Stub = function (value) {
-  this.GET   = function ()  { PIL2JS.die(".GET() of a PIL2JS.Box.Stub called!\n") }
-  this.STORE = function (n) { PIL2JS.die(".STORE() of a PIL2JS.Box.Stub called!\n"); return n };
-};
-
-PIL2JS.Box.ReadOnly.prototype = PIL2JS.Box.prototype;
-PIL2JS.Box.Constant.prototype = PIL2JS.Box.prototype;
-PIL2JS.Box.Stub.prototype     = PIL2JS.Box.prototype;
-
-// Call (possibly native sub) sub with args
-PIL2JS.call = function (inv, sub, args) {
-  if(sub == undefined)
-    PIL2JS.die("Use of uninitialized value in subroutine entry!\n");
-
-  // It's a plain sub (i.e. not method) call.
-  if(inv == undefined) {
-    // It's a boxed (and therefore Perl 6) sub.
-    if(sub.GET) {
-      var ret = sub.GET()(args);
-      if(ret == undefined)
-        PIL2JS.die("Internal error: Boxed sub returned unboxed undefined!");
-      return ret;
-    } else {
-      var code = "new PIL2JS.Box.Constant(sub(";
-      for(var i = 0; i < args.length; i++) {
-        code += "args[" + i + "].toNative(),";
-      }
-      if(args.length > 0) code = code.slice(0, -1);
-      code += "))";
-      return eval(code);
-    }
-  } else {
-    if(inv.GET) {
-      if(inv.perl_methods[sub]) {
-        return PIL2JS.call(undefined, inv.perl_methods[sub], [inv].concat(args));
-      } else {
-        PIL2JS.die("No such method: \"" + sub + "\"");
-      }
-    } else {
-      PIL2JS.die("Internal error: PIL2JS.call not implemented for invocation of native methods\n");
-    }
-  }
-};
-
-PIL2JS.make_slurpy_array = function (inp_arr) {
-  var out_arr = [];
-
-  for(var i = 0; i < inp_arr.length; i++) {
-    if(inp_arr[i].GET() instanceof Array) {
-      out_arr = out_arr.concat(inp_arr[i].GET());
-    } else {
-      out_arr.push(inp_arr[i]);
-    }
-  }
-
-  return out_arr;
-};
-
-_24main_3a_3a_3fPOSITION = new PIL2JS.Box("<unknown>");
-
-PIL2JS.new_error = function (msg) {
-  return new Error(msg.substr(-1, 1) == "\n"
-    ? msg
-    : msg + " at " + _24main_3a_3a_3fPOSITION.toNative()
-  );
-};
-PIL2JS.warn = function (msg) { alert(PIL2JS.new_error(msg)) };
-PIL2JS.die = function (msg) {
-  var error = PIL2JS.new_error(msg);
+warn "*** Compiling input PIL to JavaScript...\n" if $verbose;
+my $load_check = <<EOF;
+if(PIL2JS == undefined) {
+  var error = new Error("PIL2JS.js not loaded; aborting.");
   alert(error);
   throw(error);
-};
-
-PIL2JS.Exception = {};
-PIL2JS.Exception.last  = function () {};
-PIL2JS.Exception.next  = function () {};
-PIL2JS.Exception.ret   = function (level, retval) {
-  this.level        = level;
-  this.return_value = retval;
-  this.toString     = function () {
-    var msg = 
-      "Can't return outside a " + level + "-routine. at " +
-      _24main_3a_3a_3fPOSITION.toNative();
-    alert(msg);
-    return msg;
-  }
-};
-
-_26PIL2JS_3a_3aInternals_3a_3ageneric_return =
-  new PIL2JS.Box.Constant(function (args) {
-    var level = args[0].toNative();
-    return new PIL2JS.Box.Constant(function (args) {
-      args = PIL2JS.make_slurpy_array(args);
-      var ret =
-        args.length >  1 ? new PIL2JS.Box.Constant(args) :
-        args.length == 1 ? args[0] :
-        new PIL2J2.Box.Constant(undefined);
-      throw(new PIL2JS.Exception.ret(level, ret));
-    });
-  });
-
-PIL2JS.Pair = function (key, value) {
-  this.key   = key;
-  this.value = value;
-};
-
-PIL2JS.part_pairs = function (args) {
-  var normal_args = [];
-  var pairs       = {};
-
-  for(var i = 0; i < args.length; i++) {
-    if(args[i].GET() instanceof PIL2JS.Pair) {
-      pairs[args[i].GET().key.toNative()] = args[i].GET().value;
-    } else {
-      normal_args.push(args[i]);
-    }
-  }
-
-  return [normal_args, pairs];
-};
+}
 EOF
 
-my $js = join "\n", map { $_->as_js } @{ $tree->{"pilGlob"} }, $tree->{pilMain};
+my $program_js = join "\n",
+  $load_check,
+  map { $_->as_js } @{ $tree->{"pilGlob"} }, $tree->{pilMain};
+
+warn "*** Inlining the JavaScript Prelude (PIL2JS.pl)...\n" if $verbose;
+my $jsprelude_js = $jsprelude{mode} eq "inline" ? slurp $jsprelude{path} : undef;
+warn "*** Inlining the Perl 6 Prelude...\n" if $verbose;
+my $p6prelude_js = $p6prelude{mode} eq "inline" ? slurp $p6prelude{path} : undef;
+
+my $js;
+$js .= $jsprelude_js if $jsprelude{mode} eq "inline" and not $html;
+$js .= $p6prelude_js if $p6prelude{mode} eq "inline";
+$js .= $program_js;
 
 unless($html) {
-  print $prelude . "\n" unless $no_jsprelude;
   print $js;
 } else {
   # Output a standard HTML skeleton.
   my $indent = sub { join "\n", map { " " x 6 . $_ } split "\n", shift };
-  printf <<EOF, $no_jsprelude ? "" : $indent->($prelude), $indent->($js);
+  my $link   = sub { "<script type=\"text/javascript\" src=\"$_[0]\"></script>" };
+
+  print <<EOF;
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
@@ -229 +112 @@
     <pre id="__pil2js_tty"></pre>
 
-    @{[
-      $no_jsprelude
-        ? ""
-        : "<script type=\"text/javascript\">//<![CDATA[\n%s\n    //]]</script>\n"
-    ]}
-    @{[
-      $preludepc
-        ? "<script type=\"text/javascript\" src=\"$preludepc\"></script>\n"
-        : ""
-    ]}
+EOF
+
+  print <<EOF if $jsprelude{mode} eq "inline";
     <script type="text/javascript">//<![CDATA[
-%s
+@{[$indent->($jsprelude_js)]}
+      //]]
+    </script>
+EOF
+
+  print <<EOF;
+    @{[ $jsprelude{mode} eq "link" ? $link->($jsprelude{path}) : "" ]}
+    @{[ $p6prelude{mode} eq "link" ? $link->($p6prelude{path}) : "" ]}
+    <script type="text/javascript">//<![CDATA[
+@{[$indent->($js)]}
       //]]
     </script>
@@ -253 +138 @@
 
 Available options (options may be abbreviated to uniqueness):
-  --verbose           Sets verboseness.
-  --html              Outputs the JavaScript packed in an HTML page.
-  --no-jsprelude      Omits the part of the Prelude written in JavaScript.
-  --preludepc=http://.../preludepc.js
-                      Sets the path to a precompiled Prelude.
+  --verbose               Be verbose.
+  --html                  Output the JavaScript packed in an HTML page.
+
+  --jsprelude-mode=no|inline|link
+  --p6preludepc-mode=no|inline|link
+                          Don't include, inline, or link to the specified part
+                          of the Prelude.
+
+  --jsprelude-path=...
+  --p6preludepc-path=...
+                          Sets the path to the specified part of the Prelude.
+
+  --yaml-dump             Only output the PIL as YAML; don't compile anything.
 
 Recommended usage:
   \$ cd perl5/PIL2JS
   \$ pugs -CPIL -Ilib6 -MPrelude::JS -we 'say 2 + 3' | \
-    ./pil2js.pl --html > test.js
+    ./pil2js.pl --html --p6preludepc-mode=no > test.js
   # or (*much* faster)
   \$ pugs -CPIL -Ilib6 -MPrelude::JS -we '' | \
-    ./pil2js.pl --no-jsprelude > preludepc.js
+    ./pil2js.pl --jsprelude-mode=no --p6preludepc-mode=no > preludepc.js
   \$ pugs -CPIL -we 'say 2 + 3' | \
-    ./pil2js.pl --html --preludepc="http://.../preludepc.js" > test.js
+    ./pil2js.pl --html --p6preludepc="http://.../preludepc.js" > test.js
 
 USAGE

src/Pugs/Compile.hs

@@ -89 +89 @@
     show PNil = "PNil"
     show PNoop = "PNoop"
+    -- We don't show the raw Exp here to ease writing parsers for PIL (Exp
+    -- contains things like MkEnv, etc.).
     show (PPos x _ z) = "(PPos " ++ show x ++ " Noop " ++ show z ++ ")"
     show (PApp x y i z) = "(PApp " ++ show x ++ " " ++ show y ++ " " ++ show i ++ " " ++ show z ++ ")"