Changeset 6376

Timestamp:

08/20/05 15:47:35 (3 years ago)

Author:

iblech

svk:copy_cache_prev:

8581

Message:

* Usual svn props.
* PIL2JS: &?CALLER_CONTINUATION.

• t/unspecced/cont.t: Added some type annotations and a new test. PIL2JS passes 14/14 with 6 unexpected succeedings. :)
• PIL, PIL2JS.js: PIL2JS.cps2normal now works correctly with functions which reach the end of the program (this can happen, for example, with continuations :)). Previously, the program flow was restarted after the call to PIL2JS.cps2normal, resulting in certain regions running twice.
• PIL, PIL::PVar, PIL::Subs: sub foo { {return}() } didn't compile, because PIL2JS only kept track of the current subtype, not of all subs it's currently in. Fixed.

* PIL2JS: PIL, PIL2JS.js, README: Context objects are now unboxed -- boxing was

never needed. Should give a small speedup.

Files:

• examples/hop6/LICENSE.txt (modified) (2 props)
• examples/hop6/Lexer.pm (modified) (2 props)
• examples/hop6/Parser.pm (modified) (2 props)
• examples/hop6/Stream.pm (modified) (2 props)
• examples/hop6/expr-parser.p6 (modified) (2 props)
• examples/hop6/it2stream.p6 (modified) (2 props)
• perl5/PIL2JS/README (modified) (1 diff)
• perl5/PIL2JS/lib/PIL.pm (modified) (4 diffs)
• perl5/PIL2JS/lib/PIL/PNil.pm (modified) (1 diff)
• perl5/PIL2JS/lib/PIL/PVar.pm (modified) (1 diff)
• perl5/PIL2JS/lib/PIL/Subs.pm (modified) (5 diffs)
• perl5/PIL2JS/lib6/Prelude/JS.pm (modified) (1 diff)
• perl5/PIL2JS/lib6/Prelude/JS/Continuations.pm (added)
• perl5/PIL2JS/libjs/PIL2JS.js (modified) (4 diffs)
• perl5/Perl6-MetaModel/t/14_AUTOLOAD.t (modified) (2 props)
• t/unspecced/cont.t (modified) (6 diffs)

perl5/PIL2JS/README

@@ -147 +147 @@
 
 Additionally to the arguments passed by the user, the first argument is always
-a boxed C<PIL2JS.Context> object. Methods expect C<$?SELF> as their second
+an unboxed C<PIL2JS.Context> object. Methods expect C<$?SELF> as their second
 argument.
 

perl5/PIL2JS/lib/PIL.pm

@@ -18 +18 @@
 # Are we in a sublike thing? If yes, what sublevel does that thing have?
 our $IN_SUBLIKE = undef;
+our @IN_SUBLIKES;
 
 # What's the name of the sub we're currently in?
@@ -23 +24 @@
 
 # Our current pos?
-our $CUR_POS  = bless [ "<unknown>", (0) x 4 ] => "PIL::MkPos";
+our $CUR_POS  = bless {
+  posName => "<unknown>",
+  posBeginLine   => 0,
+  posBeginColumn => 0,
+  posEndLine     => 0,
+  posEndColumn   => 0,
+} => "PIL::MkPos";
 
 # Are we in pilGlob?
@@ -181 +188 @@
     "\n// End of initialization of global vars and exportation of subs.\n";
 
-  return sprintf <<EOF, $decl_js, add_indent(2, join "\n", @glob_js, $init_js, $main_js);
+  return sprintf <<EOF, $decl_js, add_indent(3, join "\n", @glob_js, $init_js, $main_js);
 %s
 PIL2JS.catch_all_exceptions(function () {
-  PIL2JS.runloop(function () {
-    var PIL2JS = AlsoPIL2JS_SpeedupHack;
-    var pad = {}; PIL2JS_subpads.push(pad);
-    pad['\$?POSITION'] = _24main_3a_3a_3fPOSITION;
-    pad['\$_']         = _24main_3a_3a_;
+  PIL2JS.catch_end_exception(function() {
+    PIL2JS.runloop(function () {
+      var PIL2JS = AlsoPIL2JS_SpeedupHack;
+      var pad = {}; PIL2JS_subpads.push(pad);
+      pad['\$?POSITION'] = _24main_3a_3a_3fPOSITION;
+      pad['\$_']         = _24main_3a_3a_;
 
 %s
+    });
   });
 });
@@ -207 +216 @@
 
   sub as_js {
-    return sprintf "new PIL2JS.Box.Constant(new PIL2JS.Context({ main: %s, type: %s }))",
+    return sprintf "new PIL2JS.Context({ main: %s, type: %s })",
       PIL::doublequote($_[0]->main),
       defined $_[0]->type

perl5/PIL2JS/lib/PIL/PNil.pm

@@ -11 +11 @@
 
 sub as_js {
-  return "" unless $PIL::IN_SUBLIKE;
+  # This is so even programs using function converted by PIL2JS.cps2normal can
+  # correctly terminate.
+  return "throw new PIL2JS.ControlException.end" unless $PIL::IN_SUBLIKE;
 
   my $cxt   = "PIL2JS.Context.ItemAny";

perl5/PIL2JS/lib/PIL/PVar.pm

@@ -7 +7 @@
   die unless keys %{ $_[0] } == 1;
   die if     ref(my $name = $_[0]->{pVarName});
+  local $_;
 
   if($name eq "&return") {
     PIL::fail("Can't return outside a subroutine!")
-      unless $PIL::IN_SUBLIKE >= PIL::SUBROUTINE;
+      unless grep { $_ >= PIL::SUBROUTINE } @PIL::IN_SUBLIKES;
+    # XXX hack?
+    return bless {
+      pVarName => PIL::RawJS->new("PIL2JS.generic_return(subreturncc)")
+    } => "PIL::PVar";
+  } elsif($name eq "&?CALLER_CONTINUATION") {
+    PIL::fail("There's no &?CALLER_CONTINUATION outside a subroutine!")
+      unless grep { $_ >= PIL::SUBROUTINE } @PIL::IN_SUBLIKES;
     # XXX hack?
     return bless {

perl5/PIL2JS/lib/PIL/Subs.pm

@@ -23 +23 @@
     $self->{pSubType} = bless [] => "PIL::$self->{pSubType}";  # minor hack
 
-    local $PIL::IN_SUBLIKE = $self->{pSubType}->as_constant;
+    local $PIL::IN_SUBLIKE  = $self->{pSubType}->as_constant;
+    local @PIL::IN_SUBLIKES = (@PIL::IN_SUBLIKES, $self->{pSubType}->as_constant);
 
     return bless {
@@ -43 +44 @@
 
     local $PIL::IN_SUBLIKE  = $self->{pSubType}->as_constant;
+    local @PIL::IN_SUBLIKES = (@PIL::IN_SUBLIKES, $self->{pSubType}->as_constant);
     local $PIL::CUR_SUBNAME = $self->{pSubName};
 
@@ -132 +134 @@
     $self->{pType} = bless [] => "PIL::$self->{pType}";  # minor hack
 
-    local $PIL::IN_SUBLIKE = $self->{pType}->as_constant;
+    local $PIL::IN_SUBLIKE  = $self->{pType}->as_constant;
+    local @PIL::IN_SUBLIKES = (@PIL::IN_SUBLIKES, $self->{pType}->as_constant);
 
     # &PIL::Params::fixup returns the fixed PIL::Params and the fixed
@@ -155 +158 @@
 
     local $PIL::IN_SUBLIKE  = $self->{pType}->as_constant;
+    local @PIL::IN_SUBLIKES = (@PIL::IN_SUBLIKES, $self->{pType}->as_constant);
     local $PIL::CUR_SUBNAME = "<anonymous@{[$PIL::CUR_SUBNAME ? ' in ' . $PIL::CUR_SUBNAME : '']}>";
 
@@ -201 +205 @@
     my $self = shift;
     local $PIL::IN_SUBLIKE  = PIL::SUBTHUNK;
+    local @PIL::IN_SUBLIKES = (@PIL::IN_SUBLIKES, PIL::SUBTHUNK);
     local $PIL::CUR_SUBNAME = "<thunk@{[$PIL::CUR_SUBNAME ? ' in ' . $PIL::CUR_SUBNAME : '']}>";
 

perl5/PIL2JS/lib6/Prelude/JS.pm

@@ -15 +15 @@
 
 use Prelude::JS::Code;
+use Prelude::JS::Continuations;
 use Prelude::JS::ControlFlow;
 use Prelude::JS::IO;

perl5/PIL2JS/libjs/PIL2JS.js

@@ -182 +182 @@
       (this.uid == undefined && other.uid == undefined && this.FETCH() == other.FETCH())
     ) {
-      PIL2JS.die("Binding would create a bind cycle!");
+      // PIL2JS.die("Binding would create a bind cycle!");
+      // Bind cycles are actually legal.
     }
 
@@ -659 +660 @@
 PIL2JS.ControlException.redo.prototype.toString =
   function () { return "Can't \"redo\" outside a loop block!" };
+PIL2JS.ControlException.end   = function () {};
 
 // PIL2JS.generic_return -- generates a function, which, when invoked, will
@@ -784 +786 @@
 };
 
-PIL2JS.Context.Void      = new PIL2JS.Box.Constant(new PIL2JS.Context({ main: "void" }));
-PIL2JS.Context.ItemAny   = new PIL2JS.Box.Constant(new PIL2JS.Context({ main: "item", type: "Any" }));
-PIL2JS.Context.SlurpyAny = new PIL2JS.Box.Constant(new PIL2JS.Context({ main: "slurpy", type: "Any" }));
+PIL2JS.Context.Void      = new PIL2JS.Context({ main: "void" });
+PIL2JS.Context.ItemAny   = new PIL2JS.Context({ main: "item", type: "Any" });
+PIL2JS.Context.SlurpyAny = new PIL2JS.Context({ main: "slurpy", type: "Any" });
 
 PIL2JS.print_exception = function (err) {
@@ -804 +806 @@
   try { code() } catch(err) {
     PIL2JS.print_exception(err);
+  }
+};
+PIL2JS.catch_end_exception = function (code) {
+  try { code() } catch(err) {
+    if(err instanceof PIL2JS.ControlException.end) {
+      return;
+    } else {
+      throw err;
+    }
   }
 };

t/unspecced/cont.t

@@ -10 +10 @@
 =cut
 
-plan 13;
+plan 14;
 
 sub simple1() returns Int {
@@ -18 +18 @@
 is(simple1(), 2, 'using ec instead of return');
 
-sub simple2($n) {
+sub simple2(Num $n) {
   if ($n == 5) {
     &?CALLER_CONTINUATION(1);
@@ -35 +35 @@
 is(closure1(), 5, 'closure uses ec to escape', :todo);
 
-sub call_argument($f) {
-  return $f();
+sub call_argument(Code $f, $arg) {
+  return $f($arg);
 }
-sub foo($f) returns Int {
-  call_argument($f);
+sub foo(Code $f) returns Int {
+  call_argument($f, 8);
   return 3;
 }
-sub passing1 returns Int {
+sub passing1 () returns Int {
   foo(&?CALLER_CONTINUATION);
   return 2;
 }
-eval_is('passing1()', 8, 'ec passed as an argument', :todo);
+is(try { passing1() }, 8, 'ec passed as an argument', :todo);
 
-sub is_five($n, $f) {
+sub is_five(Num $n, Code $f) {
   if ($n == 5) {
     $f(1);
@@ -54 +54 @@
   return 0;
 }
-sub passing2_not_cont($n) {
+sub passing2_not_cont(Num $n) {
   my $a = 9;
   is_five($n, sub { $a = 1 });
   return $a;
 }
-sub passing2($n) {
+sub passing2(Num $n) {
   is_five($n, &?CALLER_CONTINUATION);
   return 9;
 }
-sub passing2_closure($n) {
+sub passing2_closure(Num $n) {
   my $c = &?CALLER_CONTINUATION;
   is_five($n, sub { $c(1) });
   return 9;
 }
-is(passing2_not_cont(5), 1, 'is_five w/o ec');
-is(passing2_not_cont(2), 9, 'is_five w/o ec');
-is(passing2(5), 1, 'is_five passing ec itself', :todo);
-is(passing2(2), 9, 'is_five passing ec itself');
-is(passing2_closure(5), 1, 'is_five passing ec via closure', :todo);
-is(passing2_closure(2), 9, 'is_five passing ec via closure');
+is(passing2_not_cont(5), 1, 'is_five w/o ec (1)');
+is(passing2_not_cont(2), 9, 'is_five w/o ec (2)');
+is(passing2(5), 1, 'is_five passing ec itself (1)', :todo);
+is(passing2(2), 9, 'is_five passing ec itself (2)');
+is(passing2_closure(5), 1, 'is_five passing ec via closure (1)', :todo);
+is(passing2_closure(2), 9, 'is_five passing ec via closure (2)');
 
 sub callconty() {
@@ -79 +79 @@
     return 1;
 }
-sub conty($c) {
+sub conty(Code $c) {
     $c(2);
+    return 3;
 }
 is(callconty(), 2, 'continuation bug', :todo<bug>);
@@ -86 +87 @@
 # Now test complicated full continuations got from the same place.
 
-sub callcc (Code &block) {  &block(&?CALLER_CONTINUATION) }
+{
+  sub callcc (Code &block) {  &block(&?CALLER_CONTINUATION) }
 
-my $cnt;
-my $counter = 0;
+  my $cont;
+  my $counter = 0;
 
-callcc -> $cc { $cnt = $cc };
-$counter++;
-ok 1, "$counter times through the loop";
-$cnt(undef) unless $counter == 3;
-is($counter, 3, "Looping with a full continuation", :todo<feature>);
+  callcc -> $cc { $cont = $cc };
+  $counter++;
+  $cont(undef) unless $counter == 3;
+  is($counter, 3, "Looping with a full continuation", :todo<feature>);
+}
+
+# Really evil: Store continuations in an aggregate
+{
+  my %conts;
+  my $foo = sub { %conts<foo> = &?CALLER_CONTINUATION; return "normalfoo" };
+  my $bar = sub { %conts<bar> = &?CALLER_CONTINUATION; return "normalbar" };
+
+  my $history;
+  my $counter = 0;
+
+  $history ~= $foo(); $history ~= "foo$counter"; $counter++;
+  $history ~= $bar(); $history ~= "bar$counter"; $counter++;
+  %conts<foo>("secondfoo") if $counter <= 2;
+  %conts<bar>("secondbar") if $counter <= 4;
+
+  is
+    $history,
+    "normalfoofoo0normalbarbar1secondfoofoo2normalbarbar3secondbarbar4",
+    "continuations stored in an aggregate with loops";
+}