a94ec36 · streamly · git.iko.soy

git.iko.soy/streamly

Use NoSpecConstr annotation on the list type

This is to avoid too many recursive specializations (because we use -fspec-constr-recursive=16) on the list argument in parselMx', leading to huge code bloat in the core and requiring a lot of memory to compile.

commita94ec3688e2f5bead1c1535dca4f29fd14318ad0 authorHarendra Kumar <harendra@composewell.com> dateTue 20 Oct 2020, 08:50 (6 years ago) parent2bc92ba

3 files changed+26−21

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Parser.hs−1 benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs−1 src/Streamly/Internal/Data/Stream/StreamD.hs+26−19

benchmark/Streamly/Benchmark/Data/Parser.hs−1

@@ -6,7 +6,6 @@

66-- Maintainer : streamly@composewell.com

88{-# LANGUAGE FlexibleContexts #-}

9−{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}

109

1110module Main

1211 (

benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs−1

@@ -7,7 +7,6 @@

88{-# LANGUAGE CPP #-}

99{-# LANGUAGE FlexibleContexts #-}

10−{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}

1110

1211module Main

1312 (

src/Streamly/Internal/Data/Stream/StreamD.hs+26−19

@@ -322,6 +322,7 @@ import Data.Maybe (fromJust, isJust, isNothing)

322322import Data.Word (Word32)

323323import Foreign.Ptr (Ptr)

324324import Foreign.Storable (Storable(..))

325+import GHC.Exts (SpecConstrAnnotation(..))

325326import GHC.Types (SPEC(..))

326327import System.Mem (performMajorGC)

327328import Fusion.Plugin.Types (Fuse(..))

@@ -953,6 +954,11 @@ splitAt n ls

953954 where

954955 (xs', xs'') = splitAt' (m - 1) xs

955956

957+-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need

958+-- to make a newtype.

959+{-# ANN type List NoSpecConstr #-}

960+newtype List a = List {getList :: [a]}

961+

956962-- | Run a 'Parse' over a stream.

957963{-# INLINE_NORMAL parselMx' #-}

958964parselMx'

@@ -963,7 +969,7 @@ parselMx'

963969 -> Stream m a

964970 -> m b

965971parselMx' pstep initial extract (Stream step state) = do

966− initial >>= go SPEC state []

972+ initial >>= go SPEC state (List [])

967973

968974 where

969975

@@ -977,40 +983,41 @@ parselMx' pstep initial extract (Stream step state) = do

977983 Yield x s -> do

978984 pRes <- pstep pst x

979985 case pRes of

980− PR.Partial 0 pst1 -> go SPEC s [] pst1

986+ PR.Partial 0 pst1 -> go SPEC s (List []) pst1

981987 PR.Partial n pst1 -> do

982− assert (n <= length (x:buf)) (return ())

983− let src0 = Prelude.take n (x:buf)

988+ assert (n <= length (x:getList buf)) (return ())

989+ let src0 = Prelude.take n (x:getList buf)

984990 src = Prelude.reverse src0

985− gobuf SPEC s [] src pst1

986− PR.Continue 0 pst1 -> go SPEC s (x:buf) pst1

991+ gobuf SPEC s (List []) (List src) pst1

992+ PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1

987993 PR.Continue n pst1 -> do

988− assert (n <= length (x:buf)) (return ())

989− let (src0, buf1) = splitAt n (x:buf)

994+ assert (n <= length (x:getList buf)) (return ())

995+ let (src0, buf1) = splitAt n (x:getList buf)

990996 src = Prelude.reverse src0

991− gobuf SPEC s buf1 src pst1

997+ gobuf SPEC s (List buf1) (List src) pst1

992998 PR.Done _ b -> return b

993999 PR.Error err -> throwM $ ParseError err

9941000 Skip s -> go SPEC s buf pst

9951001 Stop -> extract pst

9961002

997− gobuf !_ s buf [] !pst = go SPEC s buf pst

998− gobuf !_ s buf (x:xs) !pst = do

1003+ gobuf !_ s buf (List []) !pst = go SPEC s buf pst

1004+ gobuf !_ s buf (List (x:xs)) !pst = do

9991005 pRes <- pstep pst x

10001006 case pRes of

10011007 PR.Partial 0 pst1 ->

1002− gobuf SPEC s [] xs pst1

1008+ gobuf SPEC s (List []) (List xs) pst1

10031009 PR.Partial n pst1 -> do

1004− assert (n <= length (x:buf)) (return ())

1005− let src0 = Prelude.take n (x:buf)

1010+ assert (n <= length (x:getList buf)) (return ())

1011+ let src0 = Prelude.take n (x:getList buf)

10061012 src = Prelude.reverse src0 ++ xs

1007− gobuf SPEC s [] src pst1

1008− PR.Continue 0 pst1 -> gobuf SPEC s (x:buf) xs pst1

1013+ gobuf SPEC s (List []) (List src) pst1

1014+ PR.Continue 0 pst1 ->

1015+ gobuf SPEC s (List (x:getList buf)) (List xs) pst1

10091016 PR.Continue n pst1 -> do

1010− assert (n <= length (x:buf)) (return ())

1011− let (src0, buf1) = splitAt n (x:buf)

1017+ assert (n <= length (x:getList buf)) (return ())

1018+ let (src0, buf1) = splitAt n (x:getList buf)

10121019 src = Prelude.reverse src0 ++ xs

1013− gobuf SPEC s buf1 src pst1

1020+ gobuf SPEC s (List buf1) (List src) pst1

10141021 PR.Done _ b -> return b

10151022 PR.Error err -> throwM $ ParseError err

10161023