Changeset 5646

Timestamp:

07/17/05 21:22:32 (3 years ago)

Author:

iblech

svk:copy_cache_prev:

7648

Message:

* Pugs.Compile -- &infix:<>(foo, bar) is compiled as &infix:<>(foo,

PThunk(bar)) now.

* Pugs.CodeGen?.PIR -- So Pugs.CodeGen?.PIR doesn't have to do this change, as

Pugs.Compile does it now.

* Pugs.Parser -- Filtered out &infix:<,> from list of user-overridable subs, as

else even basic arglists use &infix:<,> if a &infix:<,> is defined (see
comment).

* PIL2JS: Prelude::JS -- Proper support for , &&, etc.
* PIL2JS: README -- Minor cleanup.

Files:

• perl5/PIL2JS/README (modified) (1 diff)
• perl5/PIL2JS/lib6/Prelude/JS.pm (modified) (3 diffs)
• src/Pugs/CodeGen/PIR.hs (modified) (2 diffs)
• src/Pugs/Compile.hs (modified) (1 diff)
• src/Pugs/Parser.hs (modified) (1 diff)

perl5/PIL2JS/README

@@ -24 +24 @@
 =head1 WHAT'S WORKING YET?
 
-Variables, subroutine declarations (with support for C<is rw>, C<is copy>, and
-default values for optional arguments), subroutine invocations, method
-invocations, method declarations (simplified), basic operators (C<< &infix:<==>
->>, C<< &infix:<eq> >>, C<< &prefix:<+> >>, ...), basic builtins (C<say>,
-C<defined>, ...), C<if>, C<loop>.
+=over
+
+=item *
+
+Variables (scalars and arrays)
+
+=item *
+
+Subroutine and (slightly simplified) method declaration (with support for C<is
+rw>, C<is copy>, and default values for optional arguments),
+
+=item *
+
+Subroutine and method invocation
+
+=item *
+
+Basic operators (C<< &infix:<==> >>, C<< &infix:<eq> >>, C<< &prefix:<+> >>,
+...)
+
+=item *
+
+Basic builtins (C<say>, C<defined>, C<if>, C<loop>, C<while>, C<until>)
+
+=item *
+
+Global C<JS> namespace to use JavaScript's classes (e.g.
+C<$*JS::document.write>, C<JS::alert "Pugs rocks">)
+
+=back
 
 =head1 TODO
 
 =over
-
-=item *
-
-Global C<JS> namespace to use JavaScript's classes (e.g. C<$*JS::document.write>)
 
 =item *

perl5/PIL2JS/lib6/Prelude/JS.pm

@@ -124 +124 @@
     }
   ').($text);
+  ?1;
 }
 
@@ -146 +147 @@
   "infix:«%»",    "Number(a)  % Number(b)",
   "infix:«~»",    "String(a)  + String(b)",
-  "infix:«||»",   "a || b ? a : b",
-  "infix:«&&»",   "a && b ? b : a",
   "prefix:«+»",   "Number(a)",
   "prefix:«~»",   "String(a)",
@@ -182 +181 @@
 die $! if $!;
 
-sub infix:<//>($a, $b)     { defined($a) ?? $a :: $b }
-sub prefix:<++>($a is rw)  { $a = $a + 1 }
-sub postfix:<++>($a is rw) { my $cur = $a; $a = $a + 1; $cur }
-sub prefix:<-->($a is rw)  { $a = $a - 1 }
-sub postfix:<-->($a is rw) { my $cur = $a; $a = $a - 1; $cur }
-# sub infix:<,>($a, $b)      { JS::inline("function (a, b) \{
-#   return new Array(a, b);
-# \}")($a, $b) }
+sub infix:<//>   ($a, Code $b) { defined($a) ?? $a :: $b() }
+sub infix:<||>   ($a, Code $b) { $a ?? $a :: $b() }
+sub infix:<&&>   ($a, Code $b) { $a ?? $b() :: $a }
+sub infix:<err>  ($a, Code $b) { infix:<//>($a, $b()) } # XXX! hack
+sub infix:<or>   ($a, Code $b) { infix:<||>($a, $b()) } # XXX! hack
+sub infix:<and>  ($a, Code $b) { infix:<&&>($a, $b()) } # XXX! hack
+sub prefix:<++>  ($a is rw)    { $a = $a + 1 }
+sub postfix:<++> ($a is rw)    { my $cur = $a; $a = $a + 1; $cur }
+sub prefix:<-->  ($a is rw)    { $a = $a - 1 }
+sub postfix:<--> ($a is rw)    { my $cur = $a; $a = $a - 1; $cur }
+sub infix:<,>(*@xs)            { @xs }
 
 sub die(Str $msg) { $JS::PIL2JS.die($msg) }

src/Pugs/CodeGen/PIR.hs

@@ -123 +123 @@
             _           -> trans fun
         -}
-        argsC   <- if isLogicalLazy fun
-            then mapM trans (head args : map PThunk (tail args))
-            else mapM trans args
+        argsC   <- mapM trans args
         -- XXX WORKAROUND PARROT BUG (see below)
         pmc     <- genLV "app"
@@ -142 +140 @@
                 return pmc
         -}
-        where
-        -- XXX HACK
-        isLogicalLazy (PExp (PVar "&infix:or"))     = True
-        isLogicalLazy (PExp (PVar "&infix:and"))    = True
-        isLogicalLazy (PExp (PVar "&infix:||"))     = True
-        isLogicalLazy (PExp (PVar "&infix:&&"))     = True
-        isLogicalLazy _ = False
     trans (PPad SMy pad exps) = do
         valsC   <- mapM trans (map snd pad)

src/Pugs/Compile.hs

@@ -329 +329 @@
         invC    <- maybeM (return inv) compile
         argsC   <- enter cxtItemAny $ compile args
-        return $ PApp cxt funC invC argsC
+        if isLogicalLazy funC
+            then return $ PApp cxt funC invC (head argsC:map PThunk (tail argsC))
+            else return $ PApp cxt funC invC argsC
+        where
+        -- XXX HACK
+        isLogicalLazy (PExp (PVar "&infix:or"))  = True
+        isLogicalLazy (PExp (PVar "&infix:and")) = True
+        isLogicalLazy (PExp (PVar "&infix:||"))  = True
+        isLogicalLazy (PExp (PVar "&infix:&&"))  = True
+        isLogicalLazy (PExp (PVar "&infix://"))  = True
+        isLogicalLazy (PExp (PVar "&infix:err"))  = True
+        isLogicalLazy _ = False
     compile exp@(Syn "if" _) = compConditional exp
     compile (Syn "{}" (x:xs)) = compile $ App (Var "&postcircumfix:{}") (Just x) xs

src/Pugs/Parser.hs

@@ -1091 +1091 @@
     -- Finally, we return the names of the ops.
     -- But we've to s/^infix://, as we've to return (say) "+" instead of "infix:+".
-    return $ map (encodeUTF8 . unwords . nub)
+    -- Hack: Filter out &infix:<,> (which are most Preludes for PIL -> *
+    -- compilers required to define), because else basic function application
+    -- (foo(1,2,3) will get parsed as foo(&infix:<,>(1,&infix:<,>(2,3))) (bad).
+    return $ map (encodeUTF8 . unwords . filter (/= ",") . nub) $
         [nullary, optionary, namedUnary, preUnary, postUnary, infixOps]