<commit_before>module E.Demand(
    Demand(..),
    DemandSignature(..),
    DemandType(..),
    analyzeProgram,
    absSig,
    lazySig,
    lazy,
    lazyType
    ) where


import Control.Monad
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Monad.Writer
import Data.Monoid
import Data.Maybe
import Data.Typeable
import qualified Data.Map as Map

import Binary
import DataConstructors
import Doc.DocLike
import Doc.PPrint
import E.E
import E.Inline
import E.Program
import Info.Types
import GenUtil
import Name.Id
import qualified Info.Info as Info
import Util.HasSize
import Util.SetLike

data Demand =
    Bottom             -- always diverges
    | L SubDemand      -- lazy
    | S SubDemand      -- strict
    | Error SubDemand  -- diverges, might use arguments
    | Absent           -- Not used
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}

instance Show Demand where
    showsPrec _ Bottom = ("_|_" ++)
    showsPrec _ Absent = ('A':)
    showsPrec _ (L None) = ('L':)
    showsPrec _ (L (Product ds)) = showString "L(" . foldr (.) id (map shows ds) . showString ")"
    showsPrec _ (S None) = ('S':)
    showsPrec _ (S (Product ds)) = showString "S(" . foldr (.) id (map shows ds) . showString ")"
    showsPrec _ (Error None) = showString "Err"
    showsPrec _ (Error (Product ds)) = showString "Err(" . foldr (.) id (map shows ds) . showString ")"

instance DocLike d => PPrint d Demand where
    pprint demand = tshow demand

data SubDemand = None | Product [Demand]
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}

data DemandSignature = DemandSignature !Int DemandType
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}
data DemandType = (:=>) DemandEnv [Demand]
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}
data DemandEnv = DemandEnv (Map.Map TVr Demand) Demand
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}

instance Show DemandType where
    showsPrec _ (DemandEnv e Absent :=> d) | isEmpty e = shows d
    showsPrec _ (env :=> ds) = shows env . showString " :=> " .  shows ds

instance Show DemandEnv where
    showsPrec _ (DemandEnv m Absent) = pprint m
    showsPrec _ (DemandEnv _ Bottom) = showString "_|_"


instance Show DemandSignature where
    showsPrec _ (DemandSignature n dt) = showString "<" . shows n . showString "," . shows dt . showString ">"

idGlb = Absent

absType = (DemandEnv mempty idGlb) :=> []
botType = (DemandEnv mempty Bottom) :=> []

lazyType = (DemandEnv mempty lazy) :=> []
lazySig = DemandSignature 0 lazyType<commit_msg>improve show instance for demand environments<commit_after>module E.Demand(
    Demand(..),
    DemandSignature(..),
    DemandType(..),
    analyzeProgram,
    absSig,
    lazySig,
    lazy,
    lazyType
    ) where


import Control.Monad
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Monad.Writer
import Data.List
import Data.Monoid
import Data.Maybe
import Data.Typeable
import qualified Data.Map as Map

import Binary
import DataConstructors
import Doc.DocLike
import Doc.PPrint
import E.E
import E.Inline
import E.Program
import GenUtil
import Info.Types
import Name.Id
import qualified Info.Info as Info
import Util.HasSize
import Util.SetLike

data Demand =
    Bottom             -- always diverges
    | L SubDemand      -- lazy
    | S SubDemand      -- strict
    | Error SubDemand  -- diverges, might use arguments
    | Absent           -- Not used
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}

instance Show Demand where
    showsPrec _ Bottom = ("_|_" ++)
    showsPrec _ Absent = ('A':)
    showsPrec _ (L None) = ('L':)
    showsPrec _ (L (Product ds)) = showString "L(" . foldr (.) id (map shows ds) . showString ")"
    showsPrec _ (S None) = ('S':)
    showsPrec _ (S (Product ds)) = showString "S(" . foldr (.) id (map shows ds) . showString ")"
    showsPrec _ (Error None) = showString "Err"
    showsPrec _ (Error (Product ds)) = showString "Err(" . foldr (.) id (map shows ds) . showString ")"

instance DocLike d => PPrint d Demand where
    pprint demand = tshow demand

data SubDemand = None | Product [Demand]
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}

data DemandSignature = DemandSignature !Int DemandType
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}
data DemandType = (:=>) DemandEnv [Demand]
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}
data DemandEnv = DemandEnv (Map.Map TVr Demand) Demand
    deriving(Eq,Ord,Typeable)
        {-! derive: GhcBinary !-}

instance Show DemandType where
    showsPrec _ (DemandEnv e Absent :=> d) | isEmpty e = shows d
    showsPrec _ (env :=> ds) = shows env . showString " :=> " .  shows ds

instance Show DemandEnv where
    showsPrec _ (DemandEnv m Absent) = showString "{" . foldr (.) id (intersperse (showString ",") [ showString (pprint t) . showString " -> " . shows v | (t,v) <- Map.toList m]) . showString "}"
    showsPrec _ (DemandEnv _ Bottom) = showString "_|_"


instance Show DemandSignature where
    showsPrec _ (DemandSignature n dt) = showString "<" . shows n . showString "," . shows dt . showString ">"

idGlb = Absent

absType = (DemandEnv mempty idGlb) :=> []
botType = (DemandEnv mempty Bottom) :=> []

lazyType = (DemandEnv mempty lazy) :=> []
lazySig = DemandSignature 0 lazyType
{'fraction_non_alphanumeric': 0.1178884536467077, 'fraction_numerical': 0.00037306472673008767, 'mean_word_length': 3.0931297709923666, 'pattern_counts': {'":': 0, '<': 6, '<?xml version=': 0, '>': 22, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4456281', 'n_tokens_mistral': 1798, 'n_tokens_neox': 1783, 'n_words': 523}