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

Timestamp:

06/20/05 20:42:00 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6641

Message:

* blocks can now return values: my &x = { 3 }; say x()

Files:

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

src/Pugs/Compile/PIR.hs

@@ -189 +189 @@
     compile exp = compileStmts exp
 
-class EnterClass m a | m -> a where
+class EnterClass m a where
     enter :: a -> m b -> m b
+
+instance EnterClass CompMonad VCode where
+    enter sub = local (\e -> e{ envLValue = subLValue sub, envContext = CxtItem (subReturns sub) })
 
 instance EnterClass CompMonad Cxt where
@@ -227 +230 @@
             then case val of
                 VBool True      -> compile Noop
-                VInt x | x > 0  -> compile Noop
                 _               -> do
                     warn "Useless use of a constant in void context" val
@@ -242 +244 @@
         return $ PStmt $ PExp $ PApp TCxtVoid funC [preC, PBlock condC, PBlock bodyC, PBlock postC]
     compile exp = fmap PStmt $ compile exp
+
+{-
+subTCxt :: VCode -> Eval TCxt
+subTCxt sub = return $ if subLValue sub
+    then TCxtLValue (subReturns sub)
+    else TCxtItem (subReturns sub)
+-}
 
 askTCxt :: Eval TCxt
@@ -344 +353 @@
     compile (Syn "sub" [Val (VCode sub)]) = do
         -- XXX I'd like to lambda lift... :-/
-        _       <- askTCxt
-        bodyC   <- compile $ case subBody sub of
+        bodyC   <- enter sub $ compile $ case subBody sub of
             Syn "block" [exp]   -> exp
             exp                 -> exp
@@ -633 +641 @@
 varInit ('@':_) = text $ "PerlArray"
 varInit ('%':_) = text $ "PerlHash"
+varInit ('&':_) = text $ "PerlScalar"
 varInit x       = error $ "invalid name: " ++ x