Changeset 14997 for src/Pugs/Prim.hs

Timestamp:

01/05/07 11:01:29 (23 months ago)

Author:

audreyt

Message:

* Pugs.Prim: Fix t/xx-uncategorized/say-crash.t by printing

in 4096-byte chunks instead of running the strict encodeUTF8
on the entire string. This commit fixed the bug, but the
next one should generalize this fix to make encode/decode
sufficiently chunk-lazy...
Reported by gaal++.

Files:

• src/Pugs/Prim.hs (modified) (4 diffs)

src/Pugs/Prim.hs

@@ -1106 +1106 @@
     ys <- fromVals y
     op1 "sort" . VList $ xs ++ ys
-op2 "IO::say" = op2Print hPutStrLn
-op2 "IO::print" = op2Print hPutStr
+op2 "IO::say" = op2Print True
+op2 "IO::print" = op2Print False
 op2 "printf" = op3 "IO::printf" (VHandle stdout)
 op2 "BUILDALL" = cascadeMethod reverse "BUILD"
@@ -1161 +1161 @@
     asFractional = foldr (\d x -> (x / (base % 1)) + (d % 1)) (0 % 1)
 
-op2Print :: (Handle -> String -> IO ()) -> Val -> Val -> Eval Val
-op2Print f h v = do
+op2Print :: Bool -> Val -> Val -> Eval Val
+op2Print newline h v = do
     handle <- fromVal h
     strs   <- mapM fromVal =<< case v of
@@ -1168 +1168 @@
         _         -> return [v]
     guardIO $ do
-        f handle . concatMap encodeUTF8 $ strs
+        forM strs $ \str -> do
+            forM (chunk 4096 str) $ \chunk -> do
+                hPutStr handle chunk
+        when newline (hPutStr handle "\n")
         return $ VBool True
+    where
+    chunk :: Int -> [a] -> [[a]]
+    chunk _    [] = []
+    chunk size xs = case splitAt size xs of (xs', xs'') -> xs' : chunk size xs''
 
 op2Split :: Val -> Val -> Eval Val
@@ -1352 +1359 @@
 op3 "IO::printf" = \x y z -> do
     rv      <- evalExp $ App (_Var "&sprintf") Nothing [Val y, Val z]
-    op2Print hPutStr x rv
+    op2Print False x rv
 op3 other = \_ _ _ -> fail ("Unimplemented 3-ary op: " ++ other)