ref: 69c0d65f8744180c434940d1375622d10d218043
parent: f5b1f536ad9d78e690c09bbfcb2438631f6958a9
author: Lennart Augustsson <lennart@augustsson.net>
date: Sat Aug 26 08:46:27 EDT 2023
Make hGetContents lazy. Stylistic changes to IO.hs
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.1
-692
-(($A :0 ((_517 _471) ((($S' ($C ((($C' ($S' _517)) ($C _2)) (($B ($B (_517 _545))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B ($B $B))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) (($B $B) (($B $B) (($B $C') (($B ($S' _518)) ((($C' $B) (($B _604) (($B _535) ((($C' _641) _8) 0)))) (($B (_604 _538)) (($B (_549 "top level defns: ")) _499)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _518)) ((($C' $B) (($B _604) (($B _535) ((($C' _641) _8) 1)))) (_534 ($T (($B ($B (_604 _538))) ((($C' $B) _549) (($B (_549 " = ")) _241))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _518))) ((($C' $B) (($B $B) (($B _604) (($B _540) _11)))) (($B ($B (_549 _1))) (($B (($C' _549) _499)) (_549 (($O 10) $K))))))) (($B ($B (_517 _545))) ((($C' $B) (($B $B) (($B _604) (($B _535) ((($C' _641) _8) 0))))) (($B ($B (_604 _538))) (($B ($B (_549 "final pass "))) ((($C' ($C' _549)) (($B ($B (_512 6))) (($B ($B _499)) _635))) "ms")))))))) _3)))) _496))) (($B (($C' $C) (($B ($C _554)) _241))) (($C _567) (_584 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_549 "(($A :"))))) (($B ($B (($C' $B) (($B _549) _499)))) (($B ($B ($B (_549 (($O 32) $K))))) ((($C' $B) (($B ($C' _549)) ($B _241))) (($B (_549 ") ")) (($C _549) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _218)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _604) (($B _601) (($B (_604 _650)) (($B (_549 "main: findIdent: ")) _316))))) ($C _489)))) (($B ($B _493)) (($B (($C' _551) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _567) (_584 0)))))) (($B (_604 _217)) (($B (_549 (($O 95) $K))) _499))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _566) (_553 (_510 "-v")))) ((_583 _510) "-r"))) (($B (_547 (($O 46) $K))) (($B _603) (_552 ((_571 _626) "-i")))))) (($B (_604 _578)) ((($C' _549) (($B _603) (_552 ((_571 _626) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _637) _566) 1)) (_650 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _578)) (_553 ((_605 _646) ((_605 (_510 (($O 45) $K))) (_564 1)))))))) (($A :1 "v3.1\10&") (($A :2 ((($S' ($S' _517)) _16) (($B ($B ($B (_517 _545)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _518) (($B (_604 _536)) (($B (_604 (_565 1000000))) _44)))))) (($B ($B ($B ($B (_517 _545))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _518))) ((($C' $B) (($B $B) (($B _604) (($B _535) ((($C' _641) _8) 0))))) (($B ($B (_604 _538))) (($B ($B (_549 "combinator conversion "))) ((($C' ($C' _549)) (($B ($B (_512 6))) (($B ($B _499)) _635))) "ms"))))))) (($B ($B _519)) (($B $P) (($C _319) "main"))))))) (_551 ($T ((($C' ($C' $O)) ((($C' $B) $P) _244)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_604 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _211))) (($C' ($C' _551)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _604) (($B _601) (($B (_604 _650)) (_549 "not found "))))) ($C _212))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _243))) (($B (_604 (_601 (_650 "primlookup")))) (($C (_587 _510)) _5))))) (_650 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "S'") $S')) (($O (($P (($O 80) $K)) $P)) (($O (($P (($O 73) $K)) $I)) (($O (($P (($O 83) $K)) $S)) (($O (($P (($O 84) $K)) $T)) (($O (($P (($O 89) $K)) $Y)) (($O (($P "B'") $B')) (($O (($P "BK") $BK)) (($O (($P (($O 43) $K)) $+)) (($O (($P (($O 45) $K)
\ No newline at end of file
+693
+(($A :0 ((_517 _471) ((($S' ($C ((($C' ($S' _517)) ($C _2)) (($B ($B (_517 _545))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B ($B $B))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) (($B $B) (($B $B) (($B $C') (($B ($S' _518)) ((($C' $B) (($B _605) (($B _535) ((($C' _642) _8) 0)))) (($B (_605 _538)) (($B (_550 "top level defns: ")) _499)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _518)) ((($C' $B) (($B _605) (($B _535) ((($C' _642) _8) 1)))) (_534 ($T (($B ($B (_605 _538))) ((($C' $B) _550) (($B (_550 " = ")) _241))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _518))) ((($C' $B) (($B $B) (($B _605) (($B _540) _11)))) (($B ($B (_550 _1))) (($B (($C' _550) _499)) (_550 (($O 10) $K))))))) (($B ($B (_517 _545))) ((($C' $B) (($B $B) (($B _605) (($B _535) ((($C' _642) _8) 0))))) (($B ($B (_605 _538))) (($B ($B (_550 "final pass "))) ((($C' ($C' _550)) (($B ($B (_512 6))) (($B ($B _499)) _636))) "ms")))))))) _3)))) _496))) (($B (($C' $C) (($B ($C _555)) _241))) (($C _568) (_585 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_550 "(($A :"))))) (($B ($B (($C' $B) (($B _550) _499)))) (($B ($B ($B (_550 (($O 32) $K))))) ((($C' $B) (($B ($C' _550)) ($B _241))) (($B (_550 ") ")) (($C _550) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _218)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _605) (($B _602) (($B (_605 _651)) (($B (_550 "main: findIdent: ")) _316))))) ($C _489)))) (($B ($B _493)) (($B (($C' _552) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _568) (_585 0)))))) (($B (_605 _217)) (($B (_550 (($O 95) $K))) _499))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _567) (_554 (_510 "-v")))) ((_584 _510) "-r"))) (($B (_548 (($O 46) $K))) (($B _604) (_553 ((_572 _627) "-i")))))) (($B (_605 _579)) ((($C' _550) (($B _604) (_553 ((_572 _627) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _638) _567) 1)) (_651 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _579)) (_554 ((_606 _647) ((_606 (_510 (($O 45) $K))) (_565 1)))))))) (($A :1 "v3.1\10&") (($A :2 ((($S' ($S' _517)) _16) (($B ($B ($B (_517 _545)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _518) (($B (_605 _536)) (($B (_605 (_566 1000000))) _44)))))) (($B ($B ($B ($B (_517 _545))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _518))) ((($C' $B) (($B $B) (($B _605) (($B _535) ((($C' _642) _8) 0))))) (($B ($B (_605 _538))) (($B ($B (_550 "combinator conversion "))) ((($C' ($C' _550)) (($B ($B (_512 6))) (($B ($B _499)) _636))) "ms"))))))) (($B ($B _519)) (($B $P) (($C _319) "main"))))))) (_552 ($T ((($C' ($C' $O)) ((($C' $B) $P) _244)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_605 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _211))) (($C' ($C' _552)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _605) (($B _602) (($B (_605 _651)) (_550 "not found "))))) ($C _212))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _243))) (($B (_605 (_602 (_651 "primlookup")))) (($C (_588 _510)) _5))))) (_651 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "S'") $S')) (($O (($P (($O 80) $K)) $P)) (($O (($P (($O 73) $K)) $I)) (($O (($P (($O 83) $K)) $S)) (($O (($P (($O 84) $K)) $T)) (($O (($P (($O 89) $K)) $Y)) (($O (($P "B'") $B')) (($O (($P "BK") $BK)) (($O (($P (($O 43) $K)) $+)) (($O (($P (($O 45) $K)
\ No newline at end of file
--- a/lib/System/IO.hs
+++ b/lib/System/IO.hs
@@ -44,9 +44,10 @@
hGetChar :: Handle -> IO Char
hGetChar h = do
c <- P.primHGetChar h
- case c == negate 1 of
- False -> return (chr c)
- True -> error "hGetChar: EOF"
+ if c == negate 1 then
+ error "hGetChar: EOF"
+ else
+ return (chr c)
hPutChar :: Handle -> Char -> IO ()
hPutChar h c = P.primHPutChar h (ord c)
@@ -53,17 +54,17 @@
openFileM :: FilePath -> IOMode -> IO (Maybe Handle)
openFileM p m = do
- let {+ let
n = case m of
ReadMode -> 0
WriteMode -> 1
AppendMode -> 2
ReadWriteMode -> 3
- }
hdl <- P.primOpenFile p n
- case P.primIsNullHandle hdl of
- False -> return (Just hdl)
- True -> return Nothing
+ if P.primIsNullHandle hdl then
+ return Nothing
+ else
+ return (Just hdl)
openFile :: String -> IOMode -> IO Handle
openFile p m = do
@@ -84,24 +85,20 @@
mapM :: forall a b . (a -> IO b) -> [a] -> IO [b]
mapM f =
let
- rec arg =
- case arg of
- [] -> return []
- a : as -> do
- b <- f a
- bs <- rec as
- return (b : bs)
+ rec [] = return []
+ rec (a : as) = do
+ b <- f a
+ bs <- rec as
+ return (b : bs)
in rec
mapM_ :: forall a b . (a -> IO b) -> [a] -> IO ()
mapM_ f =
let
- rec arg =
- case arg of
- [] -> return ()
- a : as -> do
- f a
- rec as
+ rec [] = return ()
+ rec (a : as) = do
+ f a
+ rec as
in rec
when :: Bool -> IO () -> IO ()
@@ -125,24 +122,24 @@
hPutStr h s
hClose h
--- Strict readFile
+-- Lazy readFile
readFile :: FilePath -> IO String
readFile p = do
h <- openFile p ReadMode
cs <- hGetContents h
- hClose h
+ --hClose h can't close with lazy hGetContents
return cs
--- Strict hGetContents
+-- Lazy hGetContents
hGetContents :: Handle -> IO String
hGetContents h = do
c <- P.primHGetChar h
- case c == negate 1 of
- False ->
- do { cs <- hGetContents h; return (chr c:cs) }- -- This should use less stack, but it doesn't work. :(
- --return (chr c : P.primPerformIO (hGetContents h))
- True -> return ""
+ if c == negate 1 then do
+ hClose h -- EOF, so close the handle
+ return ""
+ else do
+ cs <- unsafeInterleaveIO (hGetContents h)
+ return (chr c : cs)
writeSerialized :: forall a . String -> a -> IO ()
writeSerialized p s = do
@@ -159,3 +156,6 @@
getTimeMilli :: IO Int
getTimeMilli = P.primGetTimeMilli
+
+unsafeInterleaveIO :: forall a . IO a -> IO a
+unsafeInterleaveIO ioa = return (P.primPerformIO ioa)
--
⑨