Changeset 4875 for src/Pugs/Compile/PIR.hs

Timestamp:

06/20/05 19:08:03 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6641

Message:

* closures: my $x = { say 5 }; $x() ; $x()

Files:

• src/Pugs/Compile/PIR.hs (modified) (2 diffs)

src/Pugs/Compile/PIR.hs

@@ -344 +344 @@
         -- XXX I'd like to lambda lift... :-/
         _       <- askTCxt
-        bodyC   <- compile (subBody sub)
+        bodyC   <- compile $ case subBody sub of
+            Syn "block" [exp]   -> exp
+            exp                 -> exp
         return $ PBlock bodyC
     compile (Syn "for" _) = compile Noop -- XXX TODO
@@ -473 +475 @@
         [begC, endC] <- genLabel ["blockBegin", "blockEnd"]
         this    <- genPMC "block"
-        tellIns $ "newsub" .- [reg this, bare ".Continuation", bare begC]
+        tellIns $ "newsub" .- [reg this, bare ".Closure", bare begC]
         tellIns $ "goto" .- [bare endC]
         tellLabel begC
-        cc      <- genPMC "cc"
-        fetchCC cc (reg this)
         trans body  -- XXX - consistency check
         bodyC   <- lastPMC
-        tellIns $ if parrotBrokenXXX
-            then "store_global" .- [tempSTR, bodyC] -- XXX HACK
-            else "set_args" .- [lit "(0b10)", bodyC]
---      tellIns $ "invoke" .- [reg cc]
+        tellIns $ "set_returns" .- retSigList [bodyC]
+        tellIns $ "returncc" .- []
         tellLabel endC
         return (ExpLV this)