Changeset 4885

Timestamp:

06/20/05 21:50:09 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6641

Message:

* iteration!

for 1..10 -> $x { say $x }

Location:

src

Files:

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

src/Emit/PIR.hs

@@ -219 +219 @@
 (<-&) :: [Sig] -> Expression -> [Expression] -> Ins
 {-| Calls an user-defined sub, ignoring any return values. -}
-(.&) :: String -> [Expression] -> Ins
+(.&) :: Expression -> [Expression] -> Ins
 
 namespace = DeclNS
@@ -229 +229 @@
 (.-)  = InsPrim Nothing
 (<-&) = InsFun
-(.&)  = InsFun [] . lit
+(.&)  = InsFun []
 
 {-| @$P0@ register -}
@@ -606 +606 @@
     , sub "&leave" [slurpy arg0]
         [] --> [arg0]
-    , sub "&statement_control:loop" [arg0, arg1, arg2, arg3] $
+    , sub "&statement_control:for" [arg0, arg1]
+        [ tempPMC   <-- "iter" $ [arg0]
+        , InsLabel "sc_for_next"
+        , "unless"  .- [tempPMC, bare "sc_for_last"]
+        , tempPMC2  <-- "shift" $ [tempPMC]
+        , arg1      .& [tempPMC2]
+        , "goto"    .- [bare "sc_for_next"]
+        , InsLabel "sc_for_last"
+        , "returncc" .- []
+        ]
+    , sub "&statement_control:loop" [arg0, arg1, arg2, arg3]
         [ InsLabel "sc_loop_next"
         , [reg tempPMC] <-& arg1 $ []
         , "unless" .- [tempPMC, bare "sc_loop_last"]
-        , [] <-& arg2 $ [] -- throw away the result of body...
-        , [] <-& arg3 $ [] -- ...and the post-condition
+        , arg2 .& [] -- throw away the result of body...
+        , arg3 .& [] -- ...and the post-condition
         , "goto" .- [bare "sc_loop_next"]
         , InsLabel "sc_loop_last"
@@ -645 +655 @@
         ] --> [lit True]
     , sub "&Pugs::Internals::exit" [arg0]
-        [ "&*END" .& []
+        [ lit "&*END" .& []
         , tempINT <:= arg0
         , "exit" .- [tempINT]

src/Pugs/Compile/PIR.hs

@@ -244 +244 @@
         return $ PStmt $ PExp $ PApp TCxtVoid funC
             [preC, pBlock condC, pBlock bodyC, pBlock postC]
+    compile exp@(Syn "unless" _) = fmap (PStmt . PExp) $ compConditional exp
+    compile exp@(Syn "while" _) = compLoop exp
+    compile exp@(Syn "until" _) = compLoop exp
+    compile (Syn "for" [exp, body]) = do
+        expC    <- compile exp
+        bodyC   <- compile body
+        funC    <- compile (Var "&statement_control:for")
+        return $ PStmt $ PExp $ PApp TCxtVoid funC [expC, bodyC]
+    compile (Syn "given" _) = compile (Var "$_") -- XXX
+    compile (Syn "when" _) = compile (Var "$_") -- XXX
     compile exp = fmap PStmt $ compile exp
 
@@ -297 +307 @@
         return $ PApp cxt funC argsC
     compile exp@(Syn "if" _) = compConditional exp
-    compile exp@(Syn "unless" _) = compConditional exp
-    compile exp@(Syn "while" _) = compLoop exp
-    compile exp@(Syn "until" _) = compLoop exp
-    compile (Syn "given" _) = compile (Var "$_") -- XXX
-    compile (Syn "when" _) = compile (Var "$_") -- XXX
     compile (Syn "{}" (x:xs)) = compile (App (Var "&postcircumfix:{}") (Just x) xs)
     compile (Syn "[]" (x:xs)) = do
@@ -323 +328 @@
     compile exp = compError exp
 
-compLoop :: Exp -> Comp (PIL LValue)
+compLoop :: Exp -> Comp (PIL Stmt)
 compLoop (Syn name [cond, body]) = do
     cxt     <- askTCxt
@@ -329 +334 @@
     bodyC   <- compile body
     funC    <- compile (Var $ "&statement_control:" ++ name)
-    return $ PApp cxt funC [pBlock condC, pBlock bodyC]
+    return . PStmt . PExp $ PApp cxt funC [pBlock condC, pBlock bodyC]
 compLoop exp = compError exp
 
@@ -362 +367 @@
         paramsC <- compile $ subParams sub
         return $ PCode (subType sub) paramsC bodyC
-    compile (Syn "for" _) = compile Noop -- XXX TODO
     compile (Syn "module" _) = compile Noop
     compile (Syn "match" exp) = compile $ Syn "rx" exp -- wrong