Changeset 4888

Timestamp:

06/20/05 22:13:19 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6641

Message:

* while loop and until loop

Location:

src

Files:

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

src/Emit/PIR.hs

@@ -2 +2 @@
 
 module Emit.PIR where
-import Text.PrettyPrint
 import Data.Char
+import Data.List
 import Data.Typeable
 import Emit.Common
+import Text.PrettyPrint
 
 {-| PIR code consists of declarations. -}
@@ -540 +541 @@
     , "invoke" .- [fun]
     ]
+
+{-| Creates appropriate @&statement_control:foo@ subroutines. -}
+stmtControlLoop :: VarName     -- ^ Perl 6 name of the new sub
+                -> PrimName    -- ^ PIR opcode to use for branching
+                -> Decl        -- ^ Final declaration of the sub
+stmtControlLoop name comp = sub ("&statement_control:" ++ name) [arg0, arg1] $
+    if isPost then ["goto" .- [bare redoL]] else [] ++
+    [ InsLabel nextL
+    , [reg tempPMC] <-& arg0 $ []
+    , comp      .- [tempPMC, bare lastL]
+    , InsLabel redoL
+    , arg1      .& []
+    , "goto"    .- [bare nextL]
+    , InsLabel lastL
+    , "returncc" .- []
+    ]
+    where
+    nextL = ("sc_" ++ name ++ "_next")
+    lastL = ("sc_" ++ name ++ "_last")
+    redoL = ("sc_" ++ name ++ "_redo")
+    isPost = "post" `isPrefixOf` name
 
 {-| Creates appropriate @&statement_control:foo@ subroutines. -}
@@ -614 +636 @@
         , "returncc" .- []
         ]
+    , stmtControlLoop "while" "unless"
+    , stmtControlLoop "until" "if"
     , stmtControlCond "if" "unless"
     , stmtControlCond "unless" "if"

src/Pugs/Compile/PIR.hs

@@ -247 +247 @@
     compile exp@(Syn "while" _) = compLoop exp
     compile exp@(Syn "until" _) = compLoop exp
+    compile exp@(Syn "postwhile" _) = compLoop exp
+    compile exp@(Syn "postuntil" _) = compLoop exp
     compile (Syn "for" [exp, body]) = do
         expC    <- compile exp
@@ -331 +333 @@
 compLoop (Syn name [cond, body]) = do
     cxt     <- askTCxt
-    condC   <- compile cond
-    bodyC   <- compile body
+    condC   <- enter (CxtItem $ mkType "Bool") $ compile cond
+    bodyC   <- enter CxtVoid $ compile body
     funC    <- compile (Var $ "&statement_control:" ++ name)
     return . PStmt . PExp $ PApp cxt funC [pBlock condC, pBlock bodyC]