Changeset 5940

Timestamp:

07/31/05 20:07:25 (3 years ago)

Author:

iblech

svk:copy_cache_prev:

8084

Message:

* Pugs.Compile -- Don't emit [Noop] for the empty arrayref literal ([]).
* t/var/symbolic_deref.t -- Fixed one test.
* PIL2JS:

• Finally, returning 0- or 1-elem arrays works correctly, causing many tests to pass, currently resmoking...
• Removed the now unneeded [...] hacks.
• my ($a, undef, $b) = ... works now.

Files:

• perl5/PIL2JS/lib6/Prelude/JS/Array.pm (modified) (2 diffs)
• perl5/PIL2JS/lib6/Prelude/JS/ControlFlow.pm (modified) (1 diff)
• perl5/PIL2JS/lib6/Prelude/JS/Keyed.pm (modified) (4 diffs)
• perl5/PIL2JS/libjs/PIL2JS.js (modified) (2 diffs)
• src/Pugs/Compile.hs (modified) (1 diff)
• t/var/symbolic_deref.t (modified) (1 diff)

perl5/PIL2JS/lib6/Prelude/JS/Array.pm

@@ -43 +43 @@
       return arr.join(String(sep));
     }
-  ')([@things.map:{ ~$_ }], $sep);
-  # XXX [...] hack, because @one-elem-array.map:{...} does not return an array
-  # currently, but the only item array[0]...
+  ')(@things.map:{ ~$_ }, $sep);
 }
 
@@ -181 +179 @@
 sub infix:<^..^> (Num $from, Num $to) is primitive { ($from + 1)..($to - 1) }
 
-sub infix:<,>(*@xs) is primitive {
+sub infix:<,>(*@xs is rw) is primitive is rw {
   JS::inline('new PIL2JS.Box.Constant(function (args) {
     var cxt   = args.shift();
+    var iarr  = args[0].GET();
+
     var array = [];
-    for(var i = 0; i < args[0].GET().length; i++) {
+    for(var i = 0; i < iarr.length; i++) {
       // The extra new PIL2JS.Box is necessary to make the contents of arrays
       // readwrite, i.e. my @a = (0,1,2); @a[1] = ... should work.
-      array[i] = new PIL2JS.Box(args[0].GET()[i].GET());
-    }
-    return new PIL2JS.Box.Constant(array);
+      array[i] = new PIL2JS.Box(iarr[i].GET());
+    }
+
+    // Proxy needed for ($a, $b) = (3, 4) which really is
+    // &infix:<,>($a, $b) = (3, 4);
+    var proxy = new PIL2JS.Box.Proxy(
+      function ()  { return array },
+      function (n) {
+        var marray = [];
+        for(var i = 0; i < iarr.length; i++) {
+          marray[i] = new PIL2JS.Box(undefined).BINDTO(
+            // Slighly hacky way to determine if iarr[i] is undef, i.e.
+            // it\'s needed to make
+            //   my ($a, undef, $b) = (3,4,5);
+            // work.
+            iarr[i].constant && iarr[i].GET() == undefined
+              ? new PIL2JS.Box(undefined)
+              : iarr[i]
+          );
+        }
+
+        var arr = new PIL2JS.Box([]).STORE(n).GET();
+        for(var i = 0; i < arr.length; i++) {
+          if(marray[i]) marray[i].STORE(arr[i]);
+        }
+
+        return this;
+      }
+    );
+
+    return proxy;
   })')(@xs);
 }

perl5/PIL2JS/lib6/Prelude/JS/ControlFlow.pm

@@ -1 @@
-sub JS::Root::return(*@args) is primitive {
-  PIL2JS::Internals::generic_return(5)(@args);  # XXX hardcoded sublevel
-}
-
-sub JS::Root::leave(*@args) is primitive {
-  PIL2JS::Internals::generic_return(3)(@args);  # XXX hardcoded sublevel
-}
-
 sub statement_control:<loop>($pre, Code $cond, Code $body, Code $post) is primitive {
   JS::inline('

perl5/PIL2JS/lib6/Prelude/JS/Keyed.pm

@@ -1 @@
-# XXX: The [...] hacks are there to make operations on one-elem lists work (as
-# sub foo { my @a = <a>; return @a } does not return an array with one elem but
-# the Str "a".
-
 # No MMD yet.
 method exists (Hash|Pair|Array $self: $idx) {
@@ -77 +73 @@
 method values (Hash|Pair|Array $self:) {
   if $self.isa("Hash") {
-    # XXX [...] hack, again
-    [$self.keys].map:{ $self{$_} };
+    $self.keys.map:{ $self{$_} };
   } elsif $self.isa("Pair") {
     ($self.value,);
@@ -90 +85 @@
 method kv (Hash|Pair|Array $self:) {
   if $self.isa("Hash") {
-    # XXX [...] hack
-    [$self.keys].map:{ $_, $self{$_} };
+    $self.keys.map:{ $_, $self{$_} };
   } elsif $self.isa("Pair") {
     ($self.key, $self.value);
   } elsif $self.isa("Array") {
-    # XXX [...] hack
-    [$self.keys].map:{ $_, $self[$_] };
+    $self.keys.map:{ $_, $self[$_] };
   } else {
     die ".kv does not work on objects of type {$self.ref}!";
@@ -104 +97 @@
 method pairs (Hash|Pair|Array $self:) {
   if $self.isa("Hash") {
-    # XXX [...] hack
-    [$self.keys].map:{ $_ => $self{$_}; };    # Don't remove the ";" inside the map!
+    $self.keys.map:{ $_ => $self{$_}; };    # Don't remove the ";" inside the map!
   } elsif $self.isa("Pair") {
     ($self,);
   } elsif $self.isa("Array") {
-    # XXX [...] hack
-    [$self.keys].map:{ $_ => $self[$_]; };    # ditto
+    $self.keys.map:{ $_ => $self[$_]; };    # ditto
   } else {
     die ".pairs does not work on objects of type {$self.ref}!";

perl5/PIL2JS/libjs/PIL2JS.js

@@ -302 +302 @@
   this.uid    = undefined;
   this.container_type = PIL2JS.container_type(value);
+  this.constant       = true;
 };
 
@@ -500 +501 @@
 };
 
-// &PIL2JS::Internals::generic_return -- generates a function, which, when
-// invoked, will cause a return of the given level by throwing an appropriate
-// exception.
-var _26PIL2JS_3a_3aInternals_3a_3ageneric_return =
-  new PIL2JS.Box.Constant(function (args) {
-    var cxt   = args.shift();
-    var level = args[0].toNative();
-    return new PIL2JS.Box.Constant(function (args) {
-      var cxt_ = args.shift();
-      args     = PIL2JS.make_slurpy_array(args);
-      var ret  =
-        args.length >  1 ? new PIL2JS.Box.Constant(args) :
-        args.length == 1 ? args[0] :
-        new PIL2JS.Box.Constant(undefined);
-      throw(new PIL2JS.ControlException.ret(level, ret));
-    });
+// PIL2JS.generic_return -- generates a function, which, when invoked, will
+// cause a return of the given level by throwing an appropriate exception.
+PIL2JS.generic_return = function (level) {
+  return new PIL2JS.Box.Constant(function (args) {
+    var cxt  = args.shift();
+    // args     = PIL2JS.make_slurpy_array(args);
+    var ret  =
+      args.length >  1 ? new PIL2JS.Box.Constant(args) :
+      args.length == 1 ? args[0] :
+      new PIL2JS.Box.Constant(undefined);
+    throw(new PIL2JS.ControlException.ret(level, ret));
   });
+};
+var _26main_3a_3areturn = PIL2JS.generic_return(5); // XXX hardcoded sublevel
+var _26main_3a_3aleave  = PIL2JS.generic_return(3); // XXX hardcoded sublevel
 
 PIL2JS.call_chain = [];

src/Pugs/Compile.hs

@@ -363 +363 @@
     compile (Syn "," exps) = do
         compile (App (Var "&infix:,") Nothing exps)
+    -- Minor hack, my $a = [] is parsed as my $a = [Noop], resulting in my $a =
+    -- [undef], which is wrong.
+    compile (Syn "\\[]" [Noop]) = do
+        compile (App (Var "&circumfix:[]") Nothing [])
     compile (Syn "\\[]" exps) = do
         compile (App (Var "&circumfix:[]") Nothing exps)

t/var/symbolic_deref.t

@@ -55 +55 @@
   dies_ok { $::("a_var") },
     "symbolic dereferentiation does not work for lexicals", :todo<bug>;
-  is      $::("MY::a_var"),
+  is      $::("MY::a_var"), 42,
     "symbolic dereferentiation does work for lexicals when using MY::", :todo<bug>;
 }