Changeset 5721

Timestamp:

07/20/05 22:35:24 (3 years ago)

Author:

iblech

svk:copy_cache_prev:

7696

Message:

* Usual svn properties.
* "sub foo { try { return }; say 42 }" should return from &foo and not print

42, added a test for this bug to t/builtins/control_flow/try.t (FWIW, PIL2JS
behaves correctly :)).

* Pugs.Compile -- Emit &prefix:<*> for Syn "*" so I can implement *(...) in PIL2JS.
* PIL2JS: Fixed &die (but it's actually a bug in Pugs' Parser, will write a

test tomorrow).

* PIL2JS: New builtins: &Code::arity, &Array::push, &Array::shift, &try,

&statement_control:<for> (works with n-ary subs)

* Updated PIL2JS/README and added PIL2JS to pugs::hack.

Files:

• lib/pugs/hack.pod (modified) (1 diff)
• perl5/PIL2JS/README (modified) (8 diffs)
• perl5/PIL2JS/lib/PIL/Nodes.pm (modified) (6 diffs)
• perl5/PIL2JS/lib6/Prelude/JS.pm (modified) (9 diffs)
• perl5/PIL2JS/libjs/PIL2JS.js (modified) (5 diffs)
• perl5/Perl6-MetaModel/t/80_Code.t (modified) (2 props)
• src/Pugs/Compile.hs (modified) (1 diff)
• t/builtins/control_flow/try.t (modified) (2 diffs)

lib/pugs/hack.pod

@@ -144 +144 @@
     |   |-- Code-Perl          Helper module for Perl 5 code generation
     |   |-- PIL-Run            PIL virtual machine in Perl 5
+    |   |-- PIL2JS             PIL to JavaScript compiler
     |   `-- Perl6-MetaModel    Perl 5 Prototype of the Perl 6 Metaclass model
     |

perl5/PIL2JS/README

@@ -14 +14 @@
   .
   |-- pil2js.pl           Frontend for the PIL:: modules
+  |-- runjs.pl            Compiles Perl 6 to JavaScript and runs it
+  |-- jspugs.pl           Interactive shell for PIL2JS development
   |-- lib
   |   |-- PIL
@@ -19 +21 @@
   |   |   `-- Nodes.pm    Module which provides appropriate ->as_js methods
   |   |                   for the objects returned by PIL::Parser
+  |-- lib6
   |   |-- Prelude
-  |   |   `-- JS.pm       JavaScript Prelude, written in Perl 6
+  |   |   `-- JS.pm       Part of the JavaScript Prelude,
+  |   |                   written in Perl 6
+  |-- libjs
+  |   `-- PIL2JS.js       Part of the JavaScript Prelude,
+  |                       written in JavaScript
 
 =head1 WHAT'S WORKING ALREADY?
@@ -28 +35 @@
 =item *
 
-Variables (scalars and arrays)
+Variables (scalars, arrays, and hashes), assignment, binding
 
 =item *
@@ -91 +98 @@
 function, e.g. C<@array[$idx] := $foo>.
 
+=head2 Identity comparision
+
+The C<.uid> property which every C<PIL2JS.Box> object has got contains the
+unique ID of the box (or C<undefined> if it's a C<PIL2JS.Box.Constant>, as we
+can't map all real numbers and more to a finite C<.uid>). C<< &infix:<=:=> >>
+can then compare C<this.uid> with C<other.uid>.
+
 =head2 Calling conventions
 
@@ -100 +114 @@
 extracted (see C<PIL::Nodes>, package C<PIL::Params>).
 
+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
+argument.
+
 =head2 Escape continuations
 
@@ -107 +125 @@
     // normal body here...
   } catch(err) {
-    if(err instanceof PIL2JS.Exception.ret && this_sublevel >= err.level) {
+    if(err instanceof PIL2JS.ControlException.ret && this_sublevel >= err.level) {
       // The return/leave/whatever concerns us, return!
       return err.return_value;
@@ -119 +137 @@
 C<&return> can then be simply implemented as:
 
-  throw new PIL2JS.Exception.ret(sublevel_to_break_out_of, retval);
+  throw new PIL2JS.ControlException.ret(sublevel_to_break_out_of, retval);
 
-C<&last> is similar.
+C<&last> and C<&next> are similar.
 
 =head1 TODO
@@ -129 +147 @@
 =item *
 
-Make C<use js:Foo> load C<Foo> from L<JSAN|http://www.openjsan.org/>?
+Make C<use js:Foo> load C<Foo> from L<JSAN|http://www.openjsan.org/>
 
 =item *
 
-Primitives
-
-=item *
-
-Better error reporting (with line number etc., should be relatively simple to
-implement because of C<PPos>)
-
-=back
+Primitives!
 
 =head1 AUTHOR
 
-Ingo Blechschmidt C<<iblech@web.de>>
+Ingo Blechschmidt C<< <iblech@web.de> >>
 
 =head1 LICENSE

perl5/PIL2JS/lib/PIL/Nodes.pm

@@ -32 +32 @@
 } catch(err) {
   PIL2JS.call_chain.pop();
-  if(err instanceof PIL2JS.Exception.ret && $level >= err.level) {
+  if(err instanceof PIL2JS.ControlException.ret && $level >= err.level) {
     return err.return_value;
   } else {
@@ -517 +517 @@
       PIL::Nodes::name_mangle($self->[0]),
       PIL::Nodes::doublequote($self->[0]);
+    $js .= sprintf
+      "%s.arity = %d;\n",
+      PIL::Nodes::name_mangle($self->[0]),
+      $self->[2]->arity;
 
     # Special magic for methods.
@@ -554 +558 @@
 
     # Sub declaration
-    return sprintf "new PIL2JS.Box.Constant(function (args) {\n%s\n})",
+    return sprintf "PIL2JS.Box.constant_func(%d, function (args) {\n%s\n})",
+      $self->[1]->arity,
       PIL::Nodes::add_indent 1, PIL::Nodes::generic_catch($IN_SUBLIKE, $body);
   }
@@ -570 +575 @@
 
     local $_;
-    return sprintf "new PIL2JS.Box.Constant(function (args) { var cxt = args.shift(); return(%s); })",
+    return sprintf "PIL2JS.Box.constant_func(0, function (args) { var cxt = args.shift(); return(%s); })",
       $self->[0]->as_js;
   }
@@ -590 +595 @@
     my $js;
     $js .= "var cxt   = args.shift();\n";
+    $js .= "args      = PIL2JS.possibly_flatten(args);\n";
     $js .= "var pairs = PIL2JS.grep_for_pairs(args);\n";
     $js .= $_->as_js1() . "\n" for @$self;
@@ -607 +613 @@
     return $js;
   }
+
+  sub arity {
+    local $_;
+    my $arity = 0;
+    $_->is_required and $arity++ for @{ $_[0] };
+    return $arity;
+  }
 }
 
 {
   package PIL::MkTParam;
+
+  sub is_required { $_[0]->{tpParam}{isOptional}->isa("PIL::False") }
 
   sub as_js1 {

perl5/PIL2JS/lib6/Prelude/JS.pm

@@ -30 +30 @@
             body();
           } catch(err) {
-            if(err instanceof PIL2JS.Exception.next) {
+            if(err instanceof PIL2JS.ControlException.next) {
               // Ok;
             } else {
@@ -38 +38 @@
         }
       } catch(err) {
-        if(err instanceof PIL2JS.Exception.last) {
+        if(err instanceof PIL2JS.ControlException.last) {
           return undefined;
         } else {
@@ -49 +49 @@
 }
 
-sub JS::Root::last() is primitive { JS::inline "throw(new PIL2JS.Exception.last())"; 1 }
-sub JS::Root::next() is primitive { JS::inline "throw(new PIL2JS.Exception.next())"; 1 }
+sub JS::Root::last() is primitive { JS::inline "throw(new PIL2JS.ControlException.last())"; 1 }
+sub JS::Root::next() is primitive { JS::inline "throw(new PIL2JS.ControlException.next())"; 1 }
 
 sub statement_control:<while>(Code $cond, Code $body) is primitive {
@@ -88 +88 @@
 }
 
+sub statement_control:<for>(@array is copy, Code $code) is primitive {
+  my $arity = $code.arity;
+  die "Can't use 0-ary subroutine as \"for\" body!" if $arity == 0;
+
+  while(+@array > 0) {
+    my @args = ();
+    my $i; loop $i = 0; $i < $arity; $i++ {
+      push @args: @array.shift;
+    }
+    $code(*@args);
+  }
+  undef;
+}
+
 sub JS::Root::defined($a) is primitive {
   JS::inline('
@@ -100 +114 @@
 }
 
+sub JS::Root::try(Code $code) is primitive {
+  JS::inline('new PIL2JS.Box.Constant(function (args) {
+    var cxt = args[0], code = args[1];
+    var ret = new PIL2JS.Box.Constant(undefined);
+    try { ret = code.GET()([PIL2JS.Context.ItemAny]) } catch(err) {
+      if(err instanceof PIL2JS.ControlException.ret) {
+        throw err;
+      } else {
+        _24main_3a_3a_21.STORE(new PIL2JS.Box.Constant(err.toString()));
+        return new PIL2JS.Box.Constant(undefined);
+      }
+    }
+    return ret;
+  })')($code);
+}
+
+method JS::Root::shift(Array $self:) {
+  JS::inline('new PIL2JS.Box.Constant(function (args) {
+    var ret = args[1].GET().shift();
+    return ret == undefined ? new PIL2JS.Box.Constant(undefined) : ret;
+  })')($self);
+}
+
+method JS::Root::push(Array $self: *@things) {
+  JS::inline('new PIL2JS.Box.Constant(function (args) {
+    var array = args[1].GET(), add = args[2].GET();
+    for(var i = 0; i < add.length; i++) {
+      array.push(add[i]);
+    }
+    return new PIL2JS.Box.Constant(array.length);
+  })')($self, @things);
+}
+
 method JS::Root::join(Array $self: Str $sep) {
   JS::inline('
@@ -106 +153 @@
     }
   ')($self, $sep);
+}
+
+method JS::Root::arity(Code $self:) {
+  JS::inline('new PIL2JS.Box.Constant(function (args) {
+    return new PIL2JS.Box.Constant(args[1].GET().pil2js_arity);
+  })')($self);
 }
 
@@ -358 +411 @@
 }
 
-sub infix:<=:=>($a is rw, $b is rw) is primitive { JS::inline('new PIL2JS.Box.Constant(
+sub infix:<=:=>($a, $b) is primitive { JS::inline('new PIL2JS.Box.Constant(
   function (args) {
     var cxt = args.shift();
@@ -401 +454 @@
 
 sub JS::Root::warn(Str *@msg) is primitive { $JS::PIL2JS.warn(@msg.join("")) }
-sub JS::Root::die(Str *@msg)  is primitive { $JS::PIL2JS.die.(@msg.join("")) }
+sub JS::Root::die(Str *@msg)  is primitive { $JS::PIL2JS.die(@msg.join(""))  }
 
 sub infix:«=>»($key, $value)  is primitive {
@@ -411 +464 @@
   })')($key, $value);
 }
+
+sub prefix:<*>(*@args) is primitive {
+  JS::inline('new PIL2JS.Box.Constant(function (args) {
+    var array = args[1];
+    array.GET().flatten_me = true;
+    return array;
+  })')(@args);
+}

perl5/PIL2JS/libjs/PIL2JS.js

@@ -132 +132 @@
 PIL2JS.Box.Stub.prototype     = PIL2JS.Box.prototype;
 
+PIL2JS.Box.constant_func = function (arity, f) {
+  f.pil2js_arity = arity;
+  return new PIL2JS.Box.Constant(f);
+};
+
 // Call (possibly native sub) sub with args
 PIL2JS.call = function (inv, sub, args) {
@@ -184 +189 @@
 };
 
-// Magical variable: $?POSITION.
+// Magical variables: $?POSITION and $!.
 var _24main_3a_3a_3fPOSITION = new PIL2JS.Box("<unknown>");
+var _24main_3a_3a_21         = new PIL2JS.Box(undefined);
 
 // Prettyprint an error msg.
@@ -205 +211 @@
 // &return, &leave, &last, &next are all implemented using faked escape
 // continuations, i.e. exceptions.
-PIL2JS.Exception = {};
-PIL2JS.Exception.last  = function () {};
-PIL2JS.Exception.next  = function () {};
-PIL2JS.Exception.ret   = function (level, retval) {
+PIL2JS.ControlException       = {};
+PIL2JS.ControlException.last  = function () {};
+PIL2JS.ControlException.next  = function () {};
+PIL2JS.ControlException.ret   = function (level, retval) {
   // The sublevel (SUBROUTINE, SUBBLOCK, etc.) the &return/&leave/whatever is
   // destined to.
@@ -239 +245 @@
         args.length == 1 ? args[0] :
         new PIL2JS.Box.Constant(undefined);
-      throw(new PIL2JS.Exception.ret(level, ret));
+      throw(new PIL2JS.ControlException.ret(level, ret));
     });
   });
@@ -260 +266 @@
 
   return pairs;
+};
+
+// *@foo sets @foo's .flatten_me property to true.
+// Here, we expand these flattened arrays.
+PIL2JS.possibly_flatten = function (args) {
+  var ret = [];
+
+  for(var i = 0; i < args.length; i++) {
+    if(args[i].GET() instanceof Array && args[i].GET().flatten_me) {
+      ret = ret.concat(args[i].GET());
+    } else {
+      ret.push(args[i]);
+    }
+  }
+
+  return ret;
 };
 

src/Pugs/Compile.hs

@@ -359 +359 @@
     compile (Syn "\\{}" exps) = do
         compile (App (Var "&circumfix:{}") Nothing exps)
+    compile (Syn "*" exps) = do
+        compile (App (Var "&prefix:*") Nothing exps)
     compile (Syn "=" [lhs, rhs]) = do
         lhsC <- enterLValue $ compile lhs

t/builtins/control_flow/try.t

@@ -4 +4 @@
 use Test;
 
-plan 9;
+plan 11;
 
 {
@@ -87 +87 @@
         is(eval('ref($!)'), "Dandy", ".. of the right class", :todo);
 };
+
+{
+        my $was_in_foo;
+        sub foo {
+                $was_in_foo++;
+                try { return 42 };
+                $was_in_foo++;
+                return 23;
+        }
+        is foo(), 42,      'return() inside try{}-blocks works (1)', :todo<bug>;
+        is $was_in_foo, 1, 'return() inside try{}-blocks works (2)', :todo<bug>;
+}